diff --git a/BuildContrib/create_new_extension.pl b/BuildContrib/create_new_extension.pl index 016ce199ee..8d11b19760 100755 --- a/BuildContrib/create_new_extension.pl +++ b/BuildContrib/create_new_extension.pl @@ -1,8 +1,10 @@ #!/usr/bin/perl -w # Script for Foswiki - The Free and Open Source Wiki, http://foswiki.org/ # -# Copyright (C) 2006-2008 ProjectContributors. All rights reserved. -# ProjectContributors are listed in the AUTHORS file in the root of +# Author: Crawford Currie http://c-dot.co.uk +# +# Copyright (C) 2008-2012 FoswikiContributors. All rights reserved. +# FoswikiContributors are listed in the AUTHORS file in the root of # the distribution. # # This program is free software; you can redistribute it and/or @@ -17,7 +19,377 @@ # http://www.gnu.org/copyleft/gpl.html # use strict; +use warnings; + +use File::Path (); + +# The script works by creating a new directory structure from an +# existing DS, either an Empty* template or a user-specified +# existing DS. First, a file-set of required files is built up +# and populated with the known minimum requirements. This is then +# enhanced with other files found in the template. Then each +# file is processed, importing it using renaming rules to map +# from the name of the template (e.g. EmptyContrib) to a +# symbolic name (e.g. %$MODULE%). This processed form is then +# output to the target directory after processing to expand +# all the known %$VARIABLES%. + +use constant MONITOR => 1; + +my %def; +$def{MODULE} = $ARGV[0]; +usage() unless $def{MODULE}; + +$def{MODULE} =~ /^.*?(Skin|JQueryPlugin|Plugin|Contrib|AddOn)$/; +$def{TYPE} = $1; +usage() unless $def{TYPE}; + +$def{STUBS} = $def{TYPE} =~ /Plugin$/ ? 'Plugins' : 'Contrib'; + +our $templateModule; +if ( $#ARGV >= 1 ) { + $templateModule = $ARGV[1]; +} +else { + $templateModule = "Empty$def{TYPE}"; +} + +unless ( $templateModule && -d $templateModule ) { + usage( error => "Template directory ($templateModule) does not exist" ); +} + +print "Creating $def{MODULE} from templates in $templateModule\n"; + +$def{SHORTDESCRIPTION} = + prompt( "Enter a one-line description of the extension: ", '' ); +$def{SHORTDESCRIPTION} =~ s/'/\\'/g; + +$def{AUTHOR} = + prompt( "Enter the wikiname of the author (e.g. ThomasHardy): ", '' ); + +my $modPath = "lib/Foswiki/$def{STUBS}/$def{MODULE}"; + +my $fileset = { + "$modPath/DEPENDENCIES" => { + template => "lib/Foswiki/$def{STUBS}/$templateModule/DEPENDENCIES", + extract => \&commonEmptyExtract, + unmanifest => 1 + }, + "$modPath/build.pl" => { + template => "lib/Foswiki/$def{STUBS}/$templateModule/build.pl", + extract => \&commonEmptyExtract, + unmanifest => 1, + mask => 0555 + }, + "$modPath/Config.spec" => { + template => "lib/Foswiki/$def{STUBS}/$templateModule/Config.spec", + extract => \&commonEmptyExtract + }, + "$modPath/MANIFEST" => { + template => "lib/Foswiki/$def{STUBS}/$templateModule/MANIFEST", + expand => \&manifest, + extract => \&manifestExtract, + unmanifest => 1 + }, + "data/System/$def{MODULE}.txt" => { + template => "data/System/$templateModule.txt", + extract => \&commonEmptyExtract + } +}; + +# Different filesets for different types of extension. We can't drive this +# from the MANIFEST for several reasons: +# 1) Some files may need to be renamed +# 2) Some files don't get listed in the MANIFEST +# 3) Some files have odd rewriting rules (e.g. JQuery plugins) +# so instead we ignore the manifest in the template and generate a new one +# from the fileset +if ( $def{TYPE} eq 'JQueryPlugin' ) { + $def{JQUERYPLUGIN} = + prompt( "Enter the name of the JQuery plugin you're wrapping: ", '' ); + + $def{JQUERYPLUGIN} =~ s/'/\\'/g; + $def{JQUERYPLUGINMODULE} = uc( $def{JQUERYPLUGIN} ); + $def{JQUERYPLUGINMODULELC} = lc( $def{JQUERYPLUGIN} ); + + # Add in the extra files a JQuery plugin requires + $fileset->{"$modPath/$def{JQUERYPLUGINMODULE}.pm"} = { + template => "lib/Foswiki/Plugins/EmptyJQueryPlugin/YOUR.pm", + extract => \&jqpPMExtract + }; + + $fileset->{"data/System/JQuery$def{JQUERYPLUGIN}.txt"} = { + template => "data/System/JQueryYour.txt", + extract => \&jqpExtract + }; + + $fileset->{"pub/System/$def{MODULE}/jquery.$def{JQUERYPLUGINMODULELC}.js"} + = { + template => "pub/System/EmptyJQueryPlugin/jquery.your.js", + extract => \&jqpPMExtract + }; +} + +# If we have a template dir, override the default files with those from the template +# and add any missing. +if ($templateModule) { + populateFrom( '', $templateModule ); +} + +# Expand the file set +foreach my $k ( keys %$fileset ) { + my $v = $fileset->{$k}; + if ( $v->{expand} ) { + my $data = getTemplate( $v->{template} ); + &{ $v->{expand} }($data); + } +} + +if (MONITOR) { + foreach my $k ( sort keys %$fileset ) { + my $v = $fileset->{$k}; + print STDERR "$k <= $v->{template}\n"; + } +} + +foreach my $k ( keys %$fileset ) { + my $v = $fileset->{$k}; + my $data = getTemplate( $v->{template} ); + die "No such template $v->{template}" unless defined $data; + if ( $v->{extract} ) { + $data = &{ $v->{extract} }($data); + } + writeFile( "$def{MODULE}/$k", expandVars($data), $v->{mask} ); +} + +### Utility subs. + +sub populateFrom { + my ( $path, $root ) = @_; + my $dh; + if ( opendir( $dh, "$root/$path" ) ) { + foreach my $e ( readdir($dh) ) { + next if ( $e =~ /^\./ ); + next if ( $e =~ /~$/ ); + my $f = $path ? "$path/$e" : $e; + if ( -d "$root/$f" ) { + populateFrom( $f, $root ); + } + else { + my $mask = ( stat("$root/$f") )[2]; + + # Already known? + my $found = 0; + while ( my ( $k, $v ) = each %$fileset ) { + if ( $v->{template} eq $f ) { + if ( $mask + && ( !defined $v->{mask} || $v->{mask} != $mask ) ) + { + $v->{mask} = $mask; + } + $found = 1; + } + } + unless ($found) { + add2Manifest( "template", $f, $mask, '' ); + } + } + } + closedir($dh); + } +} + +sub expandVars { + my $vars = shift; + $vars =~ s/%\$(\w+)%/expandVar($1)/ge; + $vars =~ s/%\$NOP%//g; + return $vars; +} + +sub expandVar { + my $var = shift; + return '%$' . $var . '%' unless defined $def{$var}; + return $def{$var}; +} + +sub writeFile { + my ( $filepath, $content, $mask ) = @_; + $filepath =~ m#(.*)/(.*?)#; + my ( $path, $file ) = ( $1, $2 ); + unless ( -d $path ) { + File::Path::mkpath($path) || die "Failed to mkdir $path: $!"; + } + if ( -e $filepath ) { + + # existing file + my ( $edata, $fh ) = ''; + if ( open( $fh, "<$filepath" ) ) { + local $/ = undef; + $edata = <$fh>; + } + if ( $content eq $edata ) { + print "Skipping unchanged $filepath\n"; + return; + } + unless ( $content eq $edata || ask("Overwrite $filepath") ) { + print "Skipping $filepath"; + return; + } + } + print "Writing $filepath\n"; + open( F, ">$filepath" ) || die "Failed to create $filepath: $!"; + print F $content; + close(F); + $mask |= 0200; # make sure creator can write + chmod( $mask, "$filepath" ) if defined $mask; +} + +sub getFile { + my $file = shift; + local $/ = undef; + open( F, "<$file" ) || die "Failed to open $file: $!"; + my $content = ; + close(F); + return $content; +} + +# get template file from Empty +sub getTemplate { + my ($path) = @_; + + my $found; + + if ( $templateModule && -e "$templateModule/$path" ) { + + # Found in user specified template dir + $found = "$templateModule/$path"; + } + elsif ( -e "$def{MODULE}/$path" ) { + + # probably in a checkout + $found = "$def{MODULE}/$path"; + } + elsif ( -e "core/$path" ) { + + # core subdir in a new-style checkout + $found = "core/$path"; + } + elsif ( -e $path ) { + + # in an install? Maybe? + $found = $path; + } + elsif ( $ENV{FOSWIKI_HOME} && -e "$ENV{FOSWIKI_HOME}/$path" ) { + $found = "$ENV{FOSWIKI_HOME}/$path"; + } + elsif ( $ENV{FOSWIKI_LIBS} && -e "$ENV{FOSWIKI_LIBS}/$path" ) { + $found = "$ENV{FOSWIKI_LIBS}/$path"; + } + die "Template '$path' not found in $templateModule" unless $found; + return getFile($found); +} + +# Functions that extract templates to generic reference syntax + +sub manifest { + my $s = shift; + + # If any paths in the manifest are missing from the fileset, add them + foreach my $m ( split( /\n/, $s ) ) { + if ( $m =~ /^(\w\S+)(.*)$/ ) { + my ( $f, $e ) = ( $1, $2 ); + my $mask = 0444; + if ( $e && $e =~ /^\s*(\d+)\s+(.*)$/ ) { + $mask = eval $1; + $e = $2; + } + if ( $fileset->{$f} ) { + $fileset->{$f}->{extra} = $e if $e; + $fileset->{$f}->{mask} = $mask; + } + else { + add2Manifest( "manifest", $f, $mask, $e ); + } + } + } + $s = "!noci\n"; + while ( my ( $k, $v ) = each %$fileset ) { + next if $v->{unmanifest}; + $v->{extra} = '' unless defined $v->{extra}; + $v->{mask} = 0444 unless defined $v->{mask}; + $s .= "$k $v->{mask} $v->{extra}\n"; + } + + return $s; +} + +sub add2Manifest { + my ( $what, $f, $mask, $e ) = @_; + my $rw = \&commonEmptyExtract; + if ( $f =~ /\.(\w+)/ ) { + my $fn = "${1}EmptyExtract"; + $rw = eval "\\&$fn" if ( defined(&$fn) ); + } + + #print STDERR "$f ======= $rw\n"; + my $to = expandVars( manifestExtract($f) ); + $fileset->{$to} = { + template => $f, + extract => $rw, + extra => $e, + mask => $mask, + unmanifest => ( $f =~ m#^test/# ? 1 : 0 ) + }; + if (MONITOR) { + print STDERR "Adding $what path $f => $to ", + ( $fileset->{$to}->{unmanifest} ? "\n" : "to MANIFEST\n" ); + } +} + +sub commonEmptyExtract { + my $s = shift; + die unless defined $s; + $s =~ s/$templateModule/%\$MODULE%/g; + return $s; +} + +sub manifestExtract { + my $s = shift; + + # Rename templatemodule to this module + $s =~ s/$templateModule/$def{MODULE}/gs; + + $s = commonEmptyExtract($s); + + # Special case for renaming + $s =~ s/your\.(\w+)$/'%$JQUERYPLUGINMODULELC%'.$1/e; + $s =~ s/Your\.(\w+)$/'%$JQUERYPLUGIN%'..$1/e; + $s =~ s/YOUR\.(\w+)$/'%$JQUERYPLUGINMODULE%'.$1/e; + return $s; +} + +sub pmEmptyExtract { + my $s = commonEmptyExtract(shift); + $s =~ s/^# change the package name.*$//m; # we're doing it! + $s =~ s/(\$SHORTDESCRIPTION = ').*?'/$1.'%$SHORTDESCRIPTION%'."';"/e; + return $s; +} + +sub jqpExtract { + my $s = commonEmptyExtract(shift); + $s =~ s/Your/%\$JQUERYPLUGIN%/sg; + $s =~ s/YOUR/%\$JQUERYPLUGINMODULE%/sg; + return $s; +} +sub jqpPMExtract { + my $s = jqpExtract(shift); + $s =~ s/your/%\$JQUERYPLUGINMODULELC%/sg; + return $s; +} + +# Prompt for a yes/no answer, with possible default to be applied +# when enter is hit sub ask { my ( $q, $default ) = @_; my $reply; @@ -51,6 +423,7 @@ sub ask { return ( $reply =~ /^y/i ) ? 1 : 0; } +# Prompt for an answer, with possible default when enter is hit sub prompt { my ( $q, $default ) = @_; local $/ = "\n"; @@ -66,278 +439,37 @@ sub prompt { return $reply; } +# Generate help sub usage { + my %param = @_; print STDERR < [ existing extension ] -Subversion users: Once you have created your new extension you can -move it to the root of your checkout before adding to SVN. - -Usage: $0 -HERE -} +This script will generate a new extension in a directory under the +current directory, suitable for building using the BuildContrib. -use File::Path; +You pass the name of your new extension - which must end in Skin, +JQueryPlugin, Plugin, or Contrib - to the script. For example, -# For each key in %def, the corresponding %$..% string will be expanded -# in all output files. So %$MODULE% will expand to the name of the module. -# %$...% keys not found will be left unexpanded. -my %def; -$def{MODULE} = $ARGV[0]; -usage(), exit 1 unless $def{MODULE}; -usage(), exit 1 if -d $def{MODULE}; +$0 MyNewSkin -$def{MODULE} =~ /^.*?(Skin|Plugin|Contrib|AddOn)$/; -$def{TYPE} = $1; -usage(), exit 1 unless $def{TYPE}; +will create the directory structure and support files for a new skin +called "MyNewSkin" -$def{STUBS} = $def{TYPE} eq 'Plugin' ? 'Plugins' : 'Contrib'; +You can also build a new extension using sources from an existing +extension. When you build from an existing extension, copies of all +the files in that extension will automatically be added to the new +extension. The existing extension must exist in a subdirectory of the +current directory. For example: -$def{SHORTDESCRIPTION} = - prompt( "Enter a one-line description of the extension: ", '' ); -$def{SHORTDESCRIPTION} =~ s/'/\\'/g; - -# Templates for all required files are in this script, after __DATA__ -$/ = undef; -my @DATA = split( /<<<< (.*?) >>>>\s*\n/, ); -shift @DATA; -my %data = @DATA; -my $stubPath = "$def{MODULE}/lib/Foswiki/$def{STUBS}"; -if ( $def{TYPE} eq 'Plugin' ) { - my $rewrite; - - # Look in all the possible places for EmptyPlugin - if ( -e "EmptyPlugin/lib/Foswiki/Plugins/EmptyPlugin.pm" ) { - - # probably running in a checkout - $rewrite = getFile("EmptyPlugin/lib/Foswiki/Plugins/EmptyPlugin.pm"); - } - elsif ( -e "../EmptyPlugin/lib/Foswiki/Plugins/EmptyPlugin.pm" ) { - - # core subdir in a new-style checkout - $rewrite = getFile("../EmptyPlugin/lib/Foswiki/Plugins/EmptyPlugin.pm"); - } - elsif ( -e "lib/Foswiki/Plugins/EmptyPlugin.pm" ) { - - # last ditch, get it from the install - $rewrite = getFile("lib/Foswiki/Plugins/EmptyPlugin.pm"); - } - - # Tidy up - $rewrite =~ s/Copyright .*(# This program)/$1/s; - $rewrite =~ s/^.*?__NOTE:__ /$data{PLUGIN_HEADER}/s; - $rewrite =~ s/^# change the package name.*$//m; - $rewrite =~ s/(SHORTDESCRIPTION = ').*?'/$1%\$SHORTDESCRIPTION%'/; - $rewrite =~ s/EmptyPlugin/%\$MODULE%/sg; - writeFile( $stubPath, "$def{MODULE}.pm", $rewrite ); -} -else { - writeFile( $stubPath, "$def{MODULE}.pm", - $data{PM} . ( $data{"PM_$def{TYPE}"} || '' ) ); -} -my $modPath = "$stubPath/$def{MODULE}"; -$def{UPLOADTARGETPUB} = 'http://foswiki.org/pub'; -$def{UPLOADTARGETSCRIPT} = 'http://foswiki.org/bin'; -$def{UPLOADTARGETSUFFIX} = ''; -$def{UPLOADTARGETWEB} = "Extensions"; -while (1) { - print <$path/$file" ) || die "Failed to create $path/$file: $!"; - print F $content; - close(F); -} +will generate "MyNewPlugin" using sources from ExistingPlugin as a +template. -sub getFile { - my $file = shift; - local $/ = undef; - open( F, "<$file" ) || die "Failed to open $file: $!"; - my $content = ; - close(F); - return $content; +HERE + print STDERR "\n\nERROR: $param{error}\n\n" if ( defined( $param{error} ) ); + exit 1; } -__DATA__ -<<<< build.pl >>>> -#!/usr/bin/perl -w -BEGIN { unshift @INC, split( /:/, $ENV{FOSWIKI_LIBS} ); } -use Foswiki::Contrib::Build; - -# Create the build object -$build = new Foswiki::Contrib::Build('%$MODULE%'); - -# (Optional) Set the details of the repository for uploads. -# This can be any web on any accessible Foswiki installation. -# These defaults will be used when expanding tokens in .txt -# files, but be warned, they can be overridden at upload time! - -# name of web to upload to -$build->{UPLOADTARGETWEB} = '%$UPLOADTARGETWEB%'; -# Full URL of pub directory -$build->{UPLOADTARGETPUB} = '%$UPLOADTARGETPUB%'; -# Full URL of bin directory -$build->{UPLOADTARGETSCRIPT} = '%$UPLOADTARGETSCRIPT%'; -# Script extension -$build->{UPLOADTARGETSUFFIX} = '%$UPLOADTARGETSUFFIX%'; - -# Build the target on the command line, or the default target -$build->build($build->{target}); - -<<<< DEPENDENCIES >>>> -# Dependencies for %$MODULE% -# Example: -# Time::ParseDate,>=2003.0211,cpan,Required. -# Foswiki::Plugins,>=1.2,perl,Requires version 1.2 of handler API. - -<<<< MANIFEST >>>> -# Release manifest for %$MODULE% -data/System/%$MODULE%.txt 0644 Documentation -lib/Foswiki/%$STUBS%/%$MODULE%.pm 0644 Perl module - -<<<< PLUGIN_HEADER >>>> -# %$TYPE% for Foswiki - The Free and Open Source Wiki, http://foswiki.org/ -# -# 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, published at -# http://www.gnu.org/copyleft/gpl.html - -=pod - ----+ package Foswiki::Plugins::%$MODULE% - -<<<< PM >>>> -# %$TYPE% for Foswiki - The Free and Open Source Wiki, http://foswiki.org/ -# -# 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, published at -# http://www.gnu.org/copyleft/gpl.html - -package Foswiki::%$STUBS%::%$MODULE%; - -use strict; - -# $VERSION is referred to by Foswiki, and is the only global variable that -# *must* exist in this package. This should always be in the format -# $Rev: 3193 $ so that Foswiki can determine the checked-in status of the -# extension. -our $VERSION = '$Rev$'; # version of *this file*. - -# $RELEASE is used in the "Find More Extensions" automation in configure. -# It is a manually maintained string used to identify functionality steps. -# You can use any of the following formats: -# tuple - a sequence of integers separated by . e.g. 1.2.3. The numbers -# usually refer to major.minor.patch release or similar. You can -# use as many numbers as you like e.g. '1' or '1.2.3.4.5'. -# isodate - a date in ISO8601 format e.g. 2009-08-07 -# date - a date in 1 Jun 2009 format. Three letter English month names only. -# Note: it's important that this string is exactly the same in the extension -# topic - if you use %$RELEASE% with BuildContrib this is done automatically. -our $RELEASE = '1.1.1'; - -our $SHORTDESCRIPTION = '%$SHORTDESCRIPTION%'; - -<<<< TXT >>>> ----+!! !%$MODULE% - -%SHORTDESCRIPTION% - -%TOC% - ----++ Usage - ----++ Examples - ----++ Installation Instructions - -%$INSTALL_INSTRUCTIONS% - ----++ Info - -Many thanks to the following sponsors for supporting this work: - * Acknowledge any sponsors here - -| Author(s): | | -| Copyright: | © | -| License: | [[http://www.gnu.org/licenses/gpl.html][GPL (Gnu General Public License)]] | -| Release: | %$RELEASE% | -| Version: | %$VERSION% | -| Change History: |   | -| Dependencies: | %$DEPENDENCIES% | -| Home page: | %$UPLOADTARGETSCRIPT%/view%$UPLOADTARGETSUFFIX%/%$UPLOADTARGETWEB%/%$MODULE% | -| Support: | %$UPLOADTARGETSCRIPT%/view%$UPLOADTARGETSUFFIX%/Support/%$MODULE% | - - +1; diff --git a/BuildContrib/data/System/BuildContrib.txt b/BuildContrib/data/System/BuildContrib.txt index fc26830ce5..c68514bfff 100644 --- a/BuildContrib/data/System/BuildContrib.txt +++ b/BuildContrib/data/System/BuildContrib.txt @@ -574,30 +574,38 @@ You are strongly recommended to use this Contrib to help split your code develop Another great Foswiki extension from the *WikiRing* - __Working together to improve your wiki experience__! | Authors: | [[http://c-dot.co.uk][Crawford Currie]] | -| Copyright ©: | 2004-2010, Foswiki Contributors | +| Copyright ©: | 2004-2012, Foswiki Contributors | | License: | [[http://www.gnu.org/copyleft/gpl.html][GPL]] | | Release: | %$RELEASE% | | Version: | %$VERSION% | | Change History: | | -| 19 Jan 2011: | Foswikitask:Item10272: Detect operating-system yui-compressor command before leaning on the jar file in tools/ | -| 27 Nov 2010: | Foswikitask:Item10088: Fix assumption for =%$FOSWIKIAUTHORS%= that BuildContrib is called from a standard build checkout | -| 3 Oct 2010: | Foswikitask:Item9785: Add BuildContrib.pm dummy module and document requirement. | -| 8 Sep 2010: | Foswikitask:Item9566: Foswikitask:Item9640: minor maintenance fixes | -| 28 Aug 2010: | Foswikitask:Item721: get proxy settings from environment variables | -| 06 Aug 2010: | Foswikitask:Item9439: fix the initial uplaod problem - we were reading the topic file before it had been built | -| 01 Aug 2010: | Foswikitask:Item9416: Add %$FOSWIKIAUTHORS% token, which pulls in =core/AUTHORS= verbatim | -| 31 Jul 2010: | Foswikitask:Item9415: Documentation updates | -| 27 May 2010 | Foswikitask:Item8810: improve generated manifest Foswikitask:Item9071: correct corruption of field values in target_upload | -| 30 Mar 2010 | Foswikitask:Item8804: Improve support for alternate Extension repositories. Foswiki:Development/EasierMirroringOfExtensionRepositories | -| 11 Feb 2010 | Foswikitask:Item8468: Fixed incorrect link at the top of Extension topic - Foswiki:Main.AndrewJones | -| 9 Feb 2010 | Foswikitask:Item8490: Handle 200 or 400 from GET bin/login | -| 13 Sep 2009 | Foswikitask:Item8272: Improve handling of compression targets | -| 21 Jul 2009 | Foswikitask:Item1840: check result of login attempt during perl build.pl upload | -| 20 Mar 2009 | Foswikitask:Item1338: added SHA1 checksum generation; Foswikitask:Item1192 remove more T(m)Wiki cruft; added support for new Support structure to template - Foswiki:Main.WillNorris | -| 5 Mar 2009 | Foswikitask:Item1198: Improved support for %$VERSION% (made it much more accurate) and changed the generated date format to ISO. Also added support for %$RELEASE%, an optional release identifier taken from the master perl module. | +| 1.7.0 (11 May 2012) | Foswikitask:Item11716: correct paths in generated MANIFEST; Foswikitask:Item11851: internal maintenance | +| 1.6.3 (18 Aug 2011) | Foswikitask:Item11014: Improve error message if installer not run from Foswiki root. | +| 1.6.2 (13 Jul 2011) | Foswikitask:Item10963: Perl cleanup of qw() quoting | +| 1.6.1 (10 May 2011) | Foswikitask:item9599: Don't die if =LocalSite.cfg= doesn't exist when building an extension | +| 1.6.0 (27 Mar 2011) | Foswikitask:Item10549: create_new_extension script will create a new extension using an existing one as a template | +| 1.5.3 (8 Mar 2011) | Foswikitask:Item10450: BuildContrib leaves $Rev$ tags in topics | +| 1.5.2 (19 Jan 2011) | Foswikitask:Item10272: Detect operating-system yui-compressor command before leaning on the jar file in tools/ | +| 1.5.1 (26 Dec 2010) | Foswikitask:Item10188: Fix MANIFEST skipping data/System/FooPlugin.txt, skip .git | +| 1.5.0 (18 Dec 2010) | Foswikitask:Item10173: Add create_new_extension support for JQueryPlugin | +| 1.4.5 (27 Nov 2010) | Foswikitask:Item10088: Fix assumption for =%$FOSWIKIAUTHORS%= that BuildContrib is called from a standard build checkout | +| 1.4.4 (3 Oct 2010) | Foswikitask:Item9785: Add BuildContrib.pm dummy module and document requirement. | +| 1.4.3 (8 Sep 2010) | Foswikitask:Item9566: Foswikitask:Item9640: minor maintenance fixes | +| 1.4.2 (28 Aug 2010) | Foswikitask:Item721: get proxy settings from environment variables | +| 1.4.1 (06 Aug 2010) | Foswikitask:Item9439: fix the initial upload problem - we were reading the topic file before it had been built | +| 1.4.0(01 Aug 2010) | Foswikitask:Item9416: Add %$FOSWIKIAUTHORS% token, which pulls in =core/AUTHORS= verbatim | +| 1.3.2 (31 Jul 2010) | Foswikitask:Item9415: Documentation updates | +| 1.3.1 (27 May 2010) | Foswikitask:Item8810: improve generated manifest Foswikitask:Item9071: correct corruption of field values in target_upload | +| 1.3.0 (30 Mar 2010) | Foswikitask:Item8804: Improve support for alternate Extension repositories. Foswiki:Development/EasierMirroringOfExtensionRepositories | +| 1.2.4 (11 Feb 2010) | Foswikitask:Item8468: Fixed incorrect link at the top of Extension topic - Foswiki:Main.AndrewJones | +| 1.2.3 (9 Feb 2010) | Foswikitask:Item8490: Handle 200 or 400 from GET bin/login | +| 1.2.2 (13 Sep 2009) | Foswikitask:Item8272: Improve handling of compression targets | +| 1.2.1 (21 Jul 2009) | Foswikitask:Item1840: check result of login attempt during perl build.pl upload | +| 1.2.0 (20 Mar 2009) | Foswikitask:Item1338: added SHA1 checksum generation; Foswikitask:Item1192 remove more T(m)Wiki cruft; added support for new Support structure to template - Foswiki:Main.WillNorris | +| 1.1.0 (5 Mar 2009) | Foswikitask:Item1198: Improved support for %$VERSION% (made it much more accurate) and changed the generated date format to ISO. Also added support for %$RELEASE%, an optional release identifier taken from the master perl module. | | 15 Feb 2009 | Foswikitask:Item1079: Added twiki target | -| 31 Jan 2009 | Macro expansion works even in non-english locales (Foswikitask:Item924) | -| 03 Dec 2008 | Re-release for Foswiki; copyright assigned to Foswiki Contributors | +| 1.0.1 (31 Jan 2009) | Macro expansion works even in non-english locales (Foswikitask:Item924) | +| 1.0.0 (03 Dec 2008) | Re-release for Foswiki; copyright assigned to Foswiki Contributors | %META:FILEATTACHMENT{name="logo.gif" comment="logo" attr="h" path="logo.gif"}% %META:FILEATTACHMENT{name="wikiringlogo20x20.png" attr="h" comment="" version="1"}% diff --git a/BuildContrib/lib/Foswiki/Contrib/Build.pm b/BuildContrib/lib/Foswiki/Contrib/Build.pm index aa23895e21..2d8085ea50 100644 --- a/BuildContrib/lib/Foswiki/Contrib/Build.pm +++ b/BuildContrib/lib/Foswiki/Contrib/Build.pm @@ -1,6 +1,6 @@ # -# Copyright (C) 2004 C-Dot Consultants - All rights reserved -# Copyright (C) 2008-2010 Foswiki Contributors +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2012 Foswiki Contributors # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License @@ -43,12 +43,12 @@ use warnings; use Foswiki::Time; use Foswiki::Contrib::BuildContrib; -our $basedir; -our $buildpldir; -our $libpath; +our $basedir; # Calculated root i.e one above 'lib' +our $buildpldir; # Calculated location of build.pl +our $libpath; # $basedir/lib/ -my $VERSION; -my $RELEASE; +our $VERSION; # Version of BuildContrib +our $RELEASE; # Release of BuildContrib my $UPLOADSITEPUB = 'http://foswiki.org/pub'; my $UPLOADSITESCRIPT = 'http://foswiki.org/bin'; @@ -58,37 +58,20 @@ my $UPLOADSITEEXTENSIONSWEB = "Extensions"; my $DEFAULTCUSTOMERDB = "$ENV{HOME}/customerDB"; my $FOSWIKIAUTHORSFILE = 'core/AUTHORS'; -my $GLACIERMELT = 10; # number of seconds to sleep between uploads, - # to reduce average load on server -my $lastUpload = 0; # time of last upload (0 means none yet) - -my $targetProject; # Foswiki or TWiki - -my $collector; # general purpose handle for collecting stuff - -my %minifiers; # functions used to minify +my $targetProject; # Foswiki or TWiki # use diagnostics; # use Carp (); # $SIG{__DIE__} = sub { Carp::confess $_[0] }; -my @stageFilters = ( - { RE => qr/\.txt$/, filter => 'filter_txt' }, - { RE => qr/\.pm$/, filter => 'filter_pm' }, -); - -my @compressFilters = ( - { RE => qr/\.js$/, filter => 'build_js' }, - { RE => qr/\.css$/, filter => 'build_css' }, - { RE => qr/\.gz$/, filter => 'build_gz' }, -); - -my @tidyFilters = ( { RE => qr/\.pl$/ }, { RE => qr/\.pm$/ }, ); - $ENV{'LC_ALL'} = 'C'; -sub _findRelativeTo { - my ( $startdir, $name ) = @_; +# Find a file relative to a directory passed (function call) or +# the basedir (method call) +sub findRelative { + my ( $this, $name ) = @_; + + my $startdir = ref($this) ? $this->{basedir} : $this; my @path = split( /[\/\\]+/, $startdir ); @@ -178,12 +161,12 @@ ARGH if ( -e "$buildpldir/../../../Foswiki" || -e "$buildpldir/../lib/Foswiki" ) { - $libpath = _findRelativeTo( $buildpldir, 'lib/Foswiki' ); + $libpath = findRelative( $buildpldir, 'lib/Foswiki' ); $targetProject = 'Foswiki'; } else { print STDERR "Assuming this is a TWiki project\n"; - $libpath = _findRelativeTo( $buildpldir, 'lib/TWiki' ); + $libpath = findRelative( $buildpldir, 'lib/TWiki' ); $targetProject = 'TWiki'; } die 'Could not find lib/Foswiki or lib/TWiki' unless $libpath; @@ -309,11 +292,11 @@ sub new { ############################################################## # Read the manifest - my $manifest = _findRelativeTo( $buildpldir, 'MANIFEST' ); + my $manifest = findRelative( $buildpldir, 'MANIFEST' ); if ( !defined($manifest) ) { #the core MANIFEST is in the lib dir, not the tools dir - $manifest = _findRelativeTo( $libpath, 'MANIFEST' ); + $manifest = findRelative( $libpath, 'MANIFEST' ); } ( $this->{files}, $this->{other_modules}, $this->{options} ) = Foswiki::Contrib::BuildContrib::BaseBuild::readManifest( $this->{basedir}, @@ -325,7 +308,10 @@ sub new { my $rawman = ''; my $hashtable = ''; foreach my $file ( @{ $this->{files} } ) { - $rawman .= "$file->{name},$file->{permissions},$file->{description}\n"; + $rawman .= join( ',', + map { $file->{$_} || '' } + qw{quotedName permissions md5 description} ) + . "\n"; $mantable .= " | ==" . $file->{name} . '== | ' @@ -339,20 +325,20 @@ sub new { ############################################################## # Work out the dependencies - my $dependancies = _findRelativeTo( $buildpldir, 'DEPENDENCIES' ); - if ( !defined($dependancies) ) { + my $dependencies = findRelative( $buildpldir, 'DEPENDENCIES' ); + if ( !defined($dependencies) ) { #the core DEPENDENCIES is in the lib dir, not the tools dir - $dependancies = _findRelativeTo( $libpath, 'DEPENDENCIES' ); + $dependencies = findRelative( $libpath, 'DEPENDENCIES' ); } - $this->_loadDependenciesFrom($dependancies); + $this->_loadDependenciesFrom($dependencies); # Pull in dependencies from other modules if ( $this->{other_modules} ) { foreach my $module ( @{ $this->{other_modules} } ) { try { my $depsfile = - _findRelativeTo( "$basedir/$module", 'DEPENDENCIES' ); + findRelative( "$basedir/$module", 'DEPENDENCIES' ); die 'Failed to find DEPENDENCIES for ' . $module unless $depsfile && -f $depsfile; @@ -430,7 +416,7 @@ ERROR 'POSTUNINSTALL' ) { $this->{$stage} = '# No ' . $stage . ' script'; - my $file = _findRelativeTo( $buildpldir, $stage ); + my $file = findRelative( $buildpldir, $stage ); if ( $file && open( PF, '<', $file ) ) { $this->{$stage} = "\n" . ; } @@ -442,8 +428,7 @@ ERROR $this->{INSTALL_INSTRUCTIONS} = ; # Item9416: Implements %$FOSWIKIAUTHORS%. Depends on $/ = undef - $FOSWIKIAUTHORSFILE = - _findRelativeTo( $this->{basedir}, $FOSWIKIAUTHORSFILE ); + $FOSWIKIAUTHORSFILE = $this->findRelative($FOSWIKIAUTHORSFILE); if ($FOSWIKIAUTHORSFILE) { open my $authorsfile, '<', $FOSWIKIAUTHORSFILE or die "Couldn't open $FOSWIKIAUTHORSFILE"; @@ -520,7 +505,7 @@ sub _loadConfig { } # Save the config -sub _saveConfig { +sub saveConfig { my $this = shift; if ( open( F, '>', $this->{config}->{file} ) ) { print F Data::Dumper->Dump( [ $this->{config} ] ); @@ -730,7 +715,7 @@ sub _get_repo_information { } # Filter a file from source to dest, calling $this->$sub on the text -sub _filter_file { +sub filter_file { my ( $this, $from, $to, $sub ) = @_; my $fh; open( $fh, '<', $from ) || die 'No source topic ' . $from . ' for filter'; @@ -925,18 +910,6 @@ sub prot { } } -=begin TML ----++++ _test_tar() -Determine if the tar command has --owner and --group options - -=cut - -sub _tarSupportsOwner { - - return ( `tar --owner 2>&1` =~ m/unrecognized/ ); - -} - =begin TML ---++++ sys_action(@params) @@ -982,139 +955,6 @@ sub perl_action { =begin TML ----++++ target_build -Basic build target. - -=cut - -sub target_build { - my $this = shift; -} - -=begin TML - ----++++ target_compress -Compress Javascript and CSS files. This target is "best efforts" - the build -won't fail if a source or target isn't missing. - -=cut - -sub target_compress { - my $this = shift; - my %file_ok; - foreach my $filter (@compressFilters) { - FILE: - foreach my $file ( @{ $this->{files} } ) { - next FILE if $file_ok{$file}; - - # Find files that match the build filter and try to update - # them - if ( $file->{name} =~ /$filter->{RE}/ ) { - my $fn = $filter->{filter}; - $file_ok{$file} = - $this->$fn( $this->{basedir} . '/' . $file->{name} ); - } - } - } -} - -=begin TML - ----++++ target_tidy -Reformat .pm and .pl files using perltidy default options - -=cut - -sub target_tidy { - my $this = shift; - require Perl::Tidy; # Will throw exception if not available - - # Can't use the MANIFEST list, otherwise we miss tests etc, so apply - # to all files found under lib. - require File::Find; - my @files = (); - $collector = \@files; - File::Find::find( \&_isPerl, "$this->{basedir}" ); - - foreach my $path (@files) { - print "Tidying $path\n"; - local @ARGV = ($path); - Perl::Tidy::perltidy(); - File::Copy::move( "$path.tdy", $path ); - } -} - -sub _isPerl { - if ( $File::Find::name =~ /(CVS|\.svn|\.git|~)$/ ) { - $File::Find::prune = 1; - } - elsif ( !-d $File::Find::name ) { - if ( $File::Find::name =~ /\.p[lm]$/ ) { - push( @$collector, $File::Find::name ); - } - elsif ( $File::Find::name !~ m#\.[^/]+$# - && open( F, '<', $File::Find::name ) ) - { - local $/ = "\n"; - my $shebang = ; - close(F); - if ( $shebang && $shebang =~ /^#!.*perl/ ) { - push( @$collector, $File::Find::name ); - } - } - } -} - -=begin TML - ----++++ target_test -Basic CPAN:Test::Unit test target, runs <project>Suite. - -=cut - -sub target_test { - my $this = shift; - $this->build('build'); - - # find testrunner - my $testrunner = - _findRelativeTo( $this->{basedir}, 'core/test/bin/TestRunner.pl' ) - || _findRelativeTo( $this->{basedir}, 'test/bin/TestRunner.pl' ); - - my $tests = - _findRelativeTo( $this->{basedir}, - 'test/unit/' . $this->{project} . '/' . $this->{project} . 'Suite.pm' ); - unless ($tests) { - $tests = - _findRelativeTo( $this->{basedir}, - '/core/test/unit/' . $this->{project} . 'Suite.pm' ) - || _findRelativeTo( $this->{basedir}, - '/test/unit/' . $this->{project} . 'Suite.pm' ); - unless ($tests) { - warn 'WARNING: COULD NOT FIND ANY UNIT TESTS FOR ' - . $this->{project}; - return; - } - } - unless ($testrunner) { - warn <pushd($testdir); - $this->{-v} = 1; # to get the command printed - $this->sys_action( 'perl', '-w', @inc, $testrunner, $tests ); - $this->popd(); -} - -=begin TML - ---++++ filter_txt Expands tokens. @@ -1125,7 +965,7 @@ The filter is used in the generation of documentation topics and the installer sub filter_txt { my ( $this, $from, $to ) = @_; - $this->_filter_file( + $this->filter_file( $from, $to, sub { my ( $this, $text ) = @_; @@ -1156,1835 +996,162 @@ sub _expand { } } -# Guess the name mapping for .js or .css -sub _deduceCompressibleSrc { - my ( $this, $to, $ext ) = @_; - my $from; - - if ( $to =~ /^(.*)\.compressed\.$ext$/ ) { - if ( -e "$1.uncompressed.$ext" ) { - $from = "$1.uncompressed.$ext"; - } - elsif ( -e "$1_src\.$ext" ) { - $from = "$1_src.$ext"; - } - else { - $from = "$1.$ext"; - } - } - elsif ( $to =~ /^(.*)\.$ext$/ ) { - if ( -e "$1.uncompressed.$ext" ) { - $from = "$1.uncompressed.$ext"; - } - else { - $from = "$1_src.$ext"; - } - } - return $from; -} - -# helper functions for calling minifiers -sub _cpanMinify { - my ( $this, $from, $to, $fn ) = @_; - my $f; - open( $f, '<', $from ) || die $!; - local $/ = undef; - my $text = <$f>; - close($f); - - $text = &$fn($text); - - if ( open( $f, '<', $to ) ) { - my $ot = <$f>; - close($f); - if ( $text eq $ot ) { - - #warn "$to is up to date w.r.t $from\n"; - return 1; # no changes - } - } - - open( $f, '>', $to ) || die "$to: $!"; - print $f $text; - close($f); -} - -sub _yuiMinify { - my ( $this, $from, $to, $type, $cmdtype ) = @_; - my $lcall = $ENV{'LC_ALL'}; - my $cmd; - - if ( $cmdtype == 2 ) { - $cmd = "java -jar $basedir/tools/yuicompressor.jar --type $type $from"; - } - else { - $cmd = "yui-compressor --type $type $from"; - } - unless ( $this->{-n} ) { - $cmd .= " -o $to"; - } - - #warn "$cmd\n"; - my $out = `$cmd`; - $ENV{'LC_ALL'} = $lcall; - return $out; -} - =begin TML ----++++ _haveYUI -return 1 if we have YUI as a command yui-compressor -return 2 if we have YUI as a jar file in tools +---++++ filter_pm($from, $to) +Filters expanding SVN rev number with correct version from repository +Note: unlike subversion, this puts in the version number of the whole +repository, not just this file. =cut -sub _haveYUI { - my $info = `yui-compressor -h 2>&1`; - my $result = 0; - - if ( not $? ) { - $result = 1; - } - elsif ( -e "$basedir/tools/yuicompressor.jar" ) { - - # Do we have java? - $info = `java -version 2>&1` || ''; - if ( not $? ) { - $result = 2; +sub filter_pm { + my ( $this, $from, $to ) = @_; + $this->filter_file( + $from, $to, + sub { + my ( $this, $text ) = @_; + $text =~ s/\$Rev(:\s*\d+)?\s*\$/\$Rev\: $this->{VERSION} \$/gso; + return $text; } - } - - return $result; + ); } =begin TML ----++++ build_js -Uses JavaScript::Minifier to optimise javascripts - -Several different name mappings are supported: - * XXX.uncompressed.js -> XXX.js - * XXX_src.js -> XXX.js - * XXX.uncompressed.js -> XXX.compressed.js - -These are selected between depending on which exist on disk. +---++++ copy_fileset +Copy all files in a file set from on directory root to another. =cut -sub build_js { - my ( $this, $to ) = @_; - - if ( !$minifiers{js} ) { - my $yui = _haveYUI(); - - if ($yui) { - $minifiers{js} = sub { - return $this->_yuiMinify( @_, 'js', $yui ); - }; - } - } +sub copy_fileset { + my ( $this, $set, $from, $to ) = @_; - # If no good, try the CPAN minifiers - if ( !$minifiers{js} && eval { require JavaScript::Minifier::XS; 1 } ) { - $minifiers{js} = sub { - return $this->_cpanMinify( @_, \&JavaScript::Minifier::XS::minify ); - }; - } - if ( !$minifiers{js} && eval { require JavaScript::Minifier; 1 } ) { - $minifiers{js} = sub { - return $this->_cpanMinify( - @_, - sub { - JavaScript::Minifier::minify( input => $_[0] ); - } - ); - }; + my $uncopied = scalar(@$set); + if ( $this->{-v} || $this->{-n} ) { + print 'Copying ' . $uncopied . ' files to ' . $to . "\n"; } - if ( !$minifiers{js} ) { - warn "Cannot squish $to: no minifier found\n"; - return; + foreach my $file (@$set) { + my $name = $file->{name}; + if ( !-e $from . '/' . $name ) { + die $from . '/' . $name . ' does not exist'; + } + else { + $this->cp( $from . '/' . $name, $to . '/' . $name ); + $uncopied--; + } } - - return $this->_build_compress( 'js', $to ); + die 'Files left uncopied' if ($uncopied); } =begin TML ----++++ build_css -Uses CSS::Minifier to optimise CSS files - -Several different name mappings are supported: - * XXX.uncompressed.css -> XXX.css - * XXX_src.css -> XXX.css - * XXX.uncompressed.css -> XXX.compressed.css +---++++ apply_perms +Apply perms to a fileset =cut -sub build_css { - my ( $this, $to ) = @_; - - if ( !$minifiers{css} ) { - my $yui = _haveYUI(); +sub apply_perms { + my ( $this, $set, $to ) = @_; - if ($yui) { - $minifiers{css} = sub { - return $this->_yuiMinify( @_, 'css', $yui ); - }; + foreach my $file (@$set) { + my $name = $file->{name}; + if ( defined $file->{permissions} ) { + $this->prot( $file->{permissions}, $to . '/' . $name ); } } - if ( !$minifiers{css} && eval { require CSS::Minifier::XS; 1 } ) { - $minifiers{css} = sub { - return $this->_cpanMinify( @_, \&CSS::Minifier::XS::minify ); - }; - } - if ( !$minifiers{css} && eval { require CSS::Minifier; 1 } ) { - $minifiers{css} = sub { - $this->_cpanMinify( - @_, - sub { - CSS::Minifier::minify( input => $_[0] ); - } - ); - }; - } - - return $this->_build_compress( 'css', $to ); } -sub _needsBuilding { - my ( $from, $to ) = @_; - - if ( -e $to ) { - my @fstat = stat($from); - my @tstat = stat($to); - return 0 if ( $tstat[9] >= $fstat[9] ); - } - return 1; -} +sub getTopicName { + my $this = shift; + my $topicname = $this->{project}; -sub _build_compress { - my ( $this, $type, $to ) = @_; + # Example input: Foswiki-4.0.0-beta6 + # Example output: FoswikiRelease04x00x00beta06 - if ( !$minifiers{$type} ) { - warn "Cannot squish $to: no minifier found for $type\n"; - return; - } + if ( $topicname =~ m{\d+\.\d+\.\d+} ) { - my $from = $this->_deduceCompressibleSrc( $to, $type ); - unless ( -e $from ) { + # Append 'Release' to first (word) part of name if followed by - + $topicname =~ s/^(\w+)\-/${1}Release/; - # There may be a good reason there is no minification source; - # for example, it might not be a derived object. - #warn "Minification source for $to not found\n"; - return; - } - if ( -l $to ) { + # Zero-pad numbers to two digits + $topicname =~ s/(\d+)/sprintf("%0.2i",$1)/ge; - # BuildContrib will always override links created by pseudo-install - unlink($to); - } - unless ( _needsBuilding( $from, $to ) ) { - if ( $this->{-v} || $this->{-n} ) { - warn "$to is up-to-date\n"; - } - return; + # replace . with x + $topicname =~ s/\./x/g; } - if ( !$this->{-n} ) { - &{ $minifiers{$type} }( $from, $to ); - warn "Generated $to from $from\n"; - } - else { - warn "Minify $from to $to\n"; - } + # remove dashes + $topicname =~ s/\-//g; + return $topicname; } =begin TML ----++++ build_gz -Uses Compress::Zlib to gzip files - - * xxx.yyy -> xxx.yyy.gz +---++++ target_build +Basic build target. All other build targets are implemented in the +'Targets' subdirectory in individual modules. =cut -sub build_gz { - my ( $this, $to ) = @_; - - unless ( eval { require Compress::Zlib } ) { - warn "Cannot gzip: $@\n"; - return 0; - } - - my $from = $to; - $from =~ s/\.gz$// or return 0; - return 0 unless -e $from && _needsBuilding( $from, $to ); - - if ( -l $to ) { - - # BuildContrib will always override links created by pseudo-install - unlink($to); - } - - my $f; - open( $f, '<', $from ) || die $!; - local $/ = undef; - my $text = <$f>; - close($f); - - $text = Compress::Zlib::memGzip($text); - - unless ( $this->{-n} ) { - my $f; - open( $f, '>', $to ) || die "$to: $!"; - binmode $f; - print $f $text; - close($f); - warn "Generated $to from $from\n"; - } - return 1; +sub target_build { + my $this = shift; } =begin TML ----++++ filter_pm($from, $to) -Filters expanding SVN rev number with correct version from repository -Note: unlike subversion, this puts in the version number of the whole -repository, not just this file. +---++++ target_pod + +Print POD documentation. This target does not modify any files, it simply +prints the (TML format) POD. + +POD text in =.pm= files should use TML syntax or HTML. Packages should be +introduced with a level 1 header, ---+, and each method in the package by +a level 2 header, ---++. Make sure you document any global variables used +by the module. =cut -sub filter_pm { - my ( $this, $from, $to ) = @_; - $this->_filter_file( - $from, $to, - sub { - my ( $this, $text ) = @_; - $text =~ s/\$Rev(:\s*\d+)?\s*\$/\$Rev\: $this->{VERSION} \$/gso; - return $text; - } - ); +# Defined here to work around naming clash on case-insensitive file systems +sub target_pod { + my $this = shift; + $this->build('POD'); + print $this->{POD} . "\n"; } =begin TML ----++++ target_release -Release target, builds release zip by creating a full release directory -structure in /tmp and then zipping it in one go. Only files explicitly listed -in the MANIFEST are released. Automatically runs =filter= on all =.txt= files -in the MANIFEST. +---++++ build($target) +Build the given target =cut -sub target_release { - my $this = shift; - - print <{RELEASE} of $this->{project}, from version $this->{VERSION} -GUNK if ( $this->{-v} ) { - print 'Package name will be ', $this->{project}, "\n"; - print 'Topic name will be ', $this->_getTopicName(), "\n"; + print 'Building ', $target, "\n"; } - - $this->build('compress'); - $this->build('build'); - $this->build('installer'); - $this->build('stage'); - $this->build('archive'); -} - -sub filter_tracked_pm { - my ( $this, $from, $to ) = @_; - $this->_filter_file( - $from, $to, - sub { - my ( $this, $text ) = @_; - $text =~ s/%\$TRACKINGCODE%/$this->{TRACKINGCODE}/gm; - return $text; - } - ); -} - -sub target_tracked { - my $this = shift; - local $/ = "\n"; - my %customers; - my @cuss; - my $db = prompt( "Location of customer database", $DEFAULTCUSTOMERDB ); - if ( open( F, '<', $db ) ) { - while ( my $customer = ) { - chomp($customer); - if ( $customer =~ /^(.+)\s(\S+)\s*$/ ) { - $customers{$1} = $2; + my $fn = "target_$target"; + unless ( $this->can($fn) ) { + my $file = 'Foswiki/Contrib/BuildContrib/Targets/' . $target . '.pm'; + unless ( do $file ) { + if ($@) { + die 'Failed to compile target ', $target, ': ', $@; + } + else { + die 'Failed to load target ', $target, ': ', $!; } } - close(F); - @cuss = sort keys %customers; - my $i = 0; - print join( "\n", map { $i++; "$i. $_" } @cuss ) . "\n"; - } - else { - print "$db not found: $@\n"; - print "Creating new customer DB\n"; } - - my $customer = prompt("Number (or name) of customer"); - if ( $customer =~ /^\d+$/ && $customer < scalar(@cuss) ) { - $customer = $cuss[$customer]; + $this->$fn(); + if ($@) { + die 'Failed to build ', $target, ': ', $@; } - - if ( $customers{$customer} ) { - $this->{TRACKINGCODE} = $customers{$customer}; + if ( $this->{-v} ) { + print 'Built ', $target, "\n"; } - else { - print "Customer '$customer' not known\n"; - exit 0 unless ask("Would you like to add a new customer?"); - - $this->{TRACKINGCODE} = crypt( $customer, $db ); - $this->{TRACKINGCODE} = join( '', - map { sprintf( '%02X', $_ ) } - unpack( 'c*', $this->{TRACKINGCODE} ) ); - print "New cypher is $this->{TRACKINGCODE}\n"; - $customers{$customer} = $this->{TRACKINGCODE}; - - open( F, '>', $db ) || die $@; - print F join( "\n", ) . "\n"; - close(F); - } - - warn "Tracking code is $this->{TRACKINGCODE}\n"; - - push( @stageFilters, { RE => qr/\.pm$/, filter => 'filter_tracked_pm' } ); - - $this->build('release'); -} - -=begin TML - ----++++ target_stage -stages all the files to be in the release in a tmpDir, ready for target_archive - -=cut - -sub target_stage { - my $this = shift; - my $project = $this->{project}; - - $this->{tmpDir} ||= File::Temp::tempdir( CLEANUP => 1 ); - File::Path::mkpath( $this->{tmpDir} ); - - $this->copy_fileset( $this->{files}, $this->{basedir}, $this->{tmpDir} ); - - foreach my $file ( @{ $this->{files} } ) { - foreach my $filter (@stageFilters) { - if ( $file->{name} =~ /$filter->{RE}/ ) { - my $fn = $filter->{filter}; - $this->$fn( - $this->{basedir} . '/' . $file->{name}, - $this->{tmpDir} . '/' . $file->{name} - ); - } - } - } - if ( -e $this->{tmpDir} . '/' . $this->{topic_root} . '.txt' ) { - $this->cp( - $this->{tmpDir} . '/' . $this->{topic_root} . '.txt', - $this->{basedir} . '/' . $project . '.txt' - ); - } - $this->apply_perms( $this->{files}, $this->{tmpDir} ); - - if ( $this->{other_modules} ) { - my $libs = join( ':', @INC ); - foreach my $module ( @{ $this->{other_modules} } ) { - - die "$basedir / $module does not exist, cannot build $module\n" - unless ( -e "$basedir/$module" ); - - warn "Installing $module in $this->{tmpDir}\n"; - - #SMELL: uses legacy TWIKI_ exports - my $cmd = -"export FOSWIKI_HOME=$this->{tmpDir}; export FOSWIKI_LIBS=$libs; export TWIKI_HOME=$this->{tmpDir}; export TWIKI_LIBS=$libs; cd $basedir/$module; perl build.pl handsoff_install"; - - #warn "***** running $cmd \n"; - print `$cmd`; - } - } -} - -=begin TML - ----++++ target_archive -Makes zip and tgz archives of the files in tmpDir. Also copies the installer. - -=cut - -sub target_archive { - my $this = shift; - my $project = $this->{project}; - my $target = $project; - if ( defined $this->{options}->{archive_prefix} ) { - - # optional archive name prefix - $target = "$this->{options}->{archive_prefix}$target"; - } - - die 'no tmpDir set' unless defined( $this->{tmpDir} ); - die 'no project set' unless defined($project); - die 'tmpDir (' . $this->{tmpDir} . ') not found' - unless ( -e $this->{tmpDir} ); - - $this->pushd( $this->{tmpDir} ); - - $this->apply_perms( $this->{files}, $this->{tmpDir} ); - - $this->sys_action( 'zip', '-r', '-q', $project . '.zip', '*' ); - $this->perl_action( 'File::Copy::move("' - . $project - . '.zip", "' - . $this->{basedir} . '/' - . $target - . '.zip");' ); - - # BSD and MacOS don't support owner/group options. - if ( `tar --owner 2>&1` =~ m/(?:unrecognized|not supported)/ ) { - -# SMELL: sys_action will auto quote any parameter containing a space. So the parameter -# and argument for group and user must be passed in as separate parameters. - print STDERR - "tar --owner / --group not supported. Recommend building as root\n"; - $this->sys_action( 'tar', '-czhpf', $project . '.tgz', '*' ); - } - else { - $this->sys_action( 'tar', '--owner', '0', '--group', '0', '-czhpf', - $project . '.tgz', '*' ); - } - - $this->perl_action( 'File::Copy::move("' - . $project - . '.tgz", "' - . $this->{basedir} . '/' - . $target - . '.tgz")' ); - - $this->perl_action( 'File::Copy::move("' - . $this->{tmpDir} . '/' - . $project - . '_installer","' - . $this->{basedir} . '/' - . $target - . '_installer")' ); - - $this->pushd( $this->{basedir} ); - my @fs; - foreach my $f (qw(.tgz _installer .zip)) { - push( @fs, "$target$f" ) if ( -e "$target$f" ); - } - - if ( eval { require Digest::MD5 } ) { - open( CS, '>', "$target.md5" ) || die $!; - foreach my $file (@fs) { - open( F, '<', $file ); - local $/; - my $data = ; - close(F); - my $cs = Digest::MD5::md5_hex($data); - print CS "$cs $file\n"; - } - close(CS); - print "MD5 checksums in $this->{basedir}/$target.md5\n"; - } - else { - warn - "WARNING: Digest::MD5 not installed; cannot generate MD5 checksum\n"; - } - - if ( eval { require Digest::SHA } ) { - open( CS, '>', "$target.sha1" ) || die $!; - foreach my $file (@fs) { - open( F, '<', $file ); - local $/; - my $data = ; - close(F); - my $cs = Digest::SHA::sha1_hex($data); - print CS "$cs $file\n"; - } - close(CS); - print "SHA1 checksums in $this->{basedir}/$target.sha1\n"; - } - else { - warn - "WARNING: Digest::SHA not installed; cannot generate SHA1 checksum\n"; - } - - $this->popd(); - $this->popd(); - - my $warn = 0; - foreach my $f (qw(.tgz .zip .txt _installer)) { - if ( -e "$this->{basedir}/$target$f" ) { - print "$f in $this->{basedir}/$target$f\n"; - } - else { - warn "WARNING: no $target$f was generated\n"; - $warn++; - } - } - if ($warn) { - warn <{-v} || $this->{-n} ) { - print 'Copying ' . $uncopied . ' files to ' . $to . "\n"; - } - foreach my $file (@$set) { - my $name = $file->{name}; - if ( !-e $from . '/' . $name ) { - die $from . '/' . $name . ' does not exist'; - } - else { - $this->cp( $from . '/' . $name, $to . '/' . $name ); - $uncopied--; - } - } - die 'Files left uncopied' if ($uncopied); -} - -=begin TML - ----++++ apply_perms -Apply perms to a fileset - -=cut - -sub apply_perms { - my ( $this, $set, $to ) = @_; - - foreach my $file (@$set) { - my $name = $file->{name}; - if ( defined $file->{permissions} ) { - $this->prot( $file->{permissions}, $to . '/' . $name ); - } - } -} - -=begin TML - ----++++ target_handsoff_install -Install target, installs to local install pointed at by FOSWIKI_HOME. - -Does not run the installer script. - -=cut - -sub target_handsoff_install { - my $this = shift; - $this->build('release'); - - my $home = $ENV{FOSWIKI_HOME}; - die 'FOSWIKI_HOME not set' unless $home; - $this->pushd($home); - $this->sys_action( 'tar', 'zxpf', - $this->{basedir} . '/' . $this->{project} . '.tgz' ); - - # kill off the module installer - $this->rm( $home . '/' . $this->{project} . '_installer' ); - $this->popd(); -} - -=begin TML - ----++++ target_install -Install target, installs to local twiki pointed at by FOSWIKI_HOME. - -Uses the installer script written by target_installer - -=cut - -sub target_install { - my $this = shift; - $this->build('handsoff_install'); - $this->sys_action( 'perl', $this->{project} . '_installer', 'install' ); -} - -=begin TML - ----++++ target_uninstall -Uninstall target, uninstall from local twiki pointed at by FOSWIKI_HOME. - -Uses the installer script written by target_installer - -=cut - -sub target_uninstall { - my $this = shift; - my $home = $ENV{FOSWIKI_HOME}; - die 'FOSWIKI_HOME not set' unless $home; - $this->pushd($home); - $this->sys_action( 'perl', $this->{project} . '_installer', 'uninstall' ); - $this->popd(); -} - -{ - - package Foswiki::Contrib::Build::UserAgent; - use LWP::UserAgent; - our @ISA = qw( LWP::UserAgent ); - - sub new { - my ( $class, $id, $bldr ) = @_; - my $this = $class->SUPER::new( - keep_alive => 1, - - # Item721: Get proxy settings from environment variables - env_proxy => 1 - ); - $this->{domain} = $id; - $this->{builder} = $bldr; - require HTTP::Cookies; - $this->cookie_jar( - new HTTP::Cookies( - file => "$ENV{HOME}/.lwpcookies", - autosave => 1, - ignore_discard => 1 - ) - ); - - return $this; - } - - sub get_basic_credentials { - my ( $this, $realm, $uri ) = @_; - return $this->{builder}->getCredentials( $uri->host() ); - } -} - -sub getCredentials { - my ( $this, $host ) = @_; - my $config = $this->_loadConfig(); - my $pws = $config->{passwords}->{$host}; - if ($pws) { - print "Using credentials for $host saved in $config->{file}\n"; - } - else { - local $/ = "\n"; - print 'Enter username for ', $host, ': '; - my $knownUser = ; - chomp($knownUser); - die "Inadequate user" unless length $knownUser; - print 'Password: '; - system('stty -echo'); - my $knownPass = ; - system('stty echo'); - print "\n"; # because we disabled echo - chomp($knownPass); - $pws = { user => $knownUser, pass => $knownPass }; - $config->{passwords}->{$host} = $pws; - $this->_saveConfig(); - } - return ( $pws->{user}, $pws->{pass} ); -} - -sub _getTopicName { - my $this = shift; - my $topicname = $this->{project}; - - # Example input: TWiki-4.0.0-beta6 - # Example output: TWikiRelease04x00x00beta06 - - if ( $topicname =~ m{\d+\.\d+\.\d+} ) { - - # Append 'Release' to first (word) part of name if followed by - - $topicname =~ s/^(\w+)\-/${1}Release/; - - # Zero-pad numbers to two digits - $topicname =~ s/(\d+)/sprintf("%0.2i",$1)/ge; - - # replace . with x - $topicname =~ s/\./x/g; - } - - # remove dashes - $topicname =~ s/\-//g; - return $topicname; -} - -=begin TML - ----++++ target_upload -Upload to a repository. Prompts for username and password. Uploads the zip and -the text topic to the appropriate places. Creates the topic if -necessary. - -=cut - -sub target_upload { - my $this = shift; - - unless ( eval { require LWP } ) { - warn 'LWP is not installed; cannot upload', "\n"; - return 0; - } - - my $to = $this->{project}; - - while (1) { - print <{UPLOADTARGETWEB} -PubDir: $this->{UPLOADTARGETPUB} -Scripts: $this->{UPLOADTARGETSCRIPT} -Suffix: $this->{UPLOADTARGETSUFFIX} - -If upload target does not exist, recover package form from: -Web: $this->{DOWNTARGETWEB} -Scripts: $this->{DOWNTARGETSCRIPT} -Suffix: $this->{DOWNTARGETSUFFIX} -END - - last if ask( "Is that correct? Answer 'n' to change", 1 ); - print "Enter the name of the web that contains the target repository\n"; - $this->{UPLOADTARGETWEB} = prompt( "Web", $this->{UPLOADTARGETWEB} ); - print "Enter the full URL path to the pub directory\n"; - $this->{UPLOADTARGETPUB} = prompt( "PubDir", $this->{UPLOADTARGETPUB} ); - print "Enter the full URL path to the bin directory\n"; - $this->{UPLOADTARGETSCRIPT} = - prompt( "Scripts", $this->{UPLOADTARGETSCRIPT} ); - print -"Enter the file suffix used on scripts in the bin directory (enter 'none' for none)\n"; - $this->{UPLOADTARGETSUFFIX} = - prompt( "Suffix", $this->{UPLOADTARGETSUFFIX} ); - $this->{UPLOADTARGETSUFFIX} = '' - if $this->{UPLOADTARGETSUFFIX} eq 'none'; - print -"\nEnter the alternate name of the web that contains the package form\n"; - $this->{DOWNTARGETWEB} = prompt( "Web", $this->{DOWNTARGETWEB} ); - - print "Enter the full URL path to the alternate bin directory\n"; - $this->{DOWNTARGETSCRIPT} = - prompt( "Scripts", $this->{DOWNTARGETSCRIPT} ); - print -"Enter the file suffix used on scripts in the alternate bin directory (enter 'none' for none)\n"; - $this->{DOWNTARGETSUFFIX} = - prompt( "Suffix", $this->{DOWNTARGETSUFFIX} ); - $this->{DOWNTARGETSUFFIX} = '' - if $this->{DOWNTARGETSUFFIX} eq 'none'; - - my $rep = $this->{config}->{repositories}->{ $this->{project} } || {}; - $rep->{pub} = $this->{UPLOADTARGETPUB}; - $rep->{script} = $this->{UPLOADTARGETSCRIPT}; - $rep->{suffix} = $this->{UPLOADTARGETSUFFIX}; - $rep->{web} = $this->{UPLOADTARGETWEB}; - $rep->{downscript} = $this->{DOWNTARGETSCRIPT}; - $rep->{downsuffix} = $this->{DOWNTARGETSUFFIX}; - $rep->{downweb} = $this->{DOWNTARGETWEB}; - $this->{config}->{repositories}->{ $this->{project} } = $rep; - $this->_saveConfig(); - } - - my $userAgent = - new Foswiki::Contrib::Build::UserAgent( $this->{UPLOADTARGETSCRIPT}, - $this ); - $userAgent->agent( 'ContribBuild/' . $VERSION . ' ' ); - $userAgent->cookie_jar( {} ); - $userAgent->timeout(420); - - my $topic = $this->_getTopicName(); - - # Ask for username and password - my ( $user, $pass ) = $this->getCredentials( $this->{UPLOADTARGETSCRIPT} ); - - # Ask what the user wants to upload - my $doUploadArchivesAndInstallers = - ask( "Do you want to upload the archives and installers?", 1 ); - - #need the topic at this point. - $this->build('release'); - my $topicText; - my $baseTopic = $this->{basedir} . '/' . $to . '.txt'; - local $/ = undef; # set to read to EOF - if ( open( IN_FILE, '<', $baseTopic ) ) { - print "Basing new topic on " . $baseTopic . "\n"; - $topicText = ; - close(IN_FILE); - } - else { - warn 'Failed to open base topic(' . $baseTopic . '): ' . $!; - $topicText = <_login( $userAgent, $user, $pass ); - - my $url = -"$this->{UPLOADTARGETSCRIPT}/view$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$topic"; - my $alturl = -"$this->{DOWNTARGETSCRIPT}/view$this->{DOWNTARGETSUFFIX}/$this->{DOWNTARGETWEB}/$topic"; - - # Get the old form data and attach it to the update - print "Downloading $topic to recover form\n"; - my $response = $userAgent->get("$url?raw=all"); - - my %newform; - my $formExists = 0; - - # SMELL: There appears to be no way to distinguish if Foswiki didn't - # find the topic and returns the topic creator form, or if the GET - # was successful. Foswiki always returns 200 for the status - # We need a better way of handling the not-found condition. - # For now, look to see if there is a newtopicform present. If found, - # it means that the get should be treated as a NOT FOUND. - - unless ( $response->is_success() - && !( $response->content() =~ m/
is_success ) { - print 'Failed to GET old topic ', $response->request->uri, - ' -- ', $response->status_line, "\n"; - } - - if ( ( $this->{DOWNTARGETSCRIPT} ne $this->{UPLOADTARGETSCRIPT} ) - || ( $this->{DOWNTARGETWEB} ne $this->{UPLOADTARGETWEB} ) ) - { - print "Downloading $topic from $alturl to recover form\n"; - $response = $userAgent->get("$alturl?raw=all"); - unless ( $response->is_success ) { - print 'Failed to GET old topic from Alternate location', - $response->request->uri, - $newform{formtemplate} = 'PackageForm'; - if ( $this->{project} =~ /(Plugin|Skin|Contrib|AddOn)$/ ) { - $newform{TopicClassification} = $1 . 'Package'; - } - } - } - } - if ( $response->is_success() - && !( $response->content() =~ m/content() ) ) { - - if ( $line =~ m/%META:FIELD{name="(.*?)".*?value="(.*?)"/ ) { - my $name = $1; - my $val = $2; - - # URL-decode the value - $val =~ s/%([\da-f]{2})/chr(hex($1))/gei; - - # Trim null values or we end up damaging the form - if ( defined $val && length($val) ) { - $newform{$name} = $val; - } - } - elsif ( $line =~ /META:FORM{name="PackageForm/ ) { - $newform{formtemplate} = 'PackageForm'; - $formExists = 1; - } - } - - if ( !$formExists ) { - $newform{formtemplate} ||= 'PackageForm'; - } - if ( $this->{project} =~ /(Plugin|Skin|Contrib|AddOn)$/ ) { - $newform{TopicClassification} ||= $1 . 'Package'; - } - } - - $newform{text} = $topicText; - - $this->_uploadTopic( $userAgent, $user, $pass, $topic, \%newform ); - - # Upload any 'Var*.txt' topics published by the extension - my $dataDir = $this->{basedir} . '/data/System'; - if ( opendir( DIR, $dataDir ) ) { - foreach my $f ( grep( /^Var\w+\.txt$/, readdir DIR ) ) { - if ( open( IN_FILE, '<', $this->{basedir} . '/data/System/' . $f ) ) - { - %newform = ( text => ); - close(IN_FILE); - $f =~ s/\.txt$//; - $this->_uploadTopic( $userAgent, $user, $pass, $f, \%newform ); - } - } - } - - return if ( $this->{-topiconly} ); - - # upload any attachments to the developer's version of the topic. Any other - # attachments to the topic on t.o. will still be there. - my %uploaded; # flag already uploaded - - if ($doUploadAttachments) { - foreach my $a (@attachments) { - $a =~ /name="([^"]*)"/; - my $name = $1; - next if $uploaded{$name}; - next if $name =~ /^$to(\.zip|\.tgz|_installer|\.md5|\.sha1)$/; - $a =~ /comment="([^"]*)"/; - my $comment = $1; - $a =~ /attr="([^"]*)"/; - my $attrs = $1 || ''; - - $this->_uploadAttachment( - $userAgent, - $user, - $pass, - $name, - $this->{basedir} - . '/pub/System/' - . $this->{project} . '/' - . $name, - $comment, - $attrs =~ /h/ ? 1 : 0 - ); - $uploaded{$name} = 1; - } - } - - return unless $doUploadArchivesAndInstallers; - - # Upload the standard files - foreach my $ext (qw(.zip .tgz _installer .md5 .sha1)) { - my $name = $to . $ext; - next if $uploaded{$name}; - $this->_uploadAttachment( $userAgent, $user, $pass, $to . $ext, - $this->{basedir} . '/' . $to . $ext, '' ); - $uploaded{$name} = 1; - } -} - -sub _login { - my ( $this, $userAgent, $user, $pass ) = @_; - - #Send a login request - to get a validation key for strikeone - my $response = $userAgent->get( - "$this->{UPLOADTARGETSCRIPT}/login$this->{UPLOADTARGETSUFFIX}"); - - # "(Foswiki login)" or "Login - Foswiki" - unless ( ( $response->code == 200 || $response->code == 400 ) - and $response->header('title') =~ /login/i ) - { - die 'Failed to GET login form ' - . $response->request->uri . ' -- ' - . $response->status_line . "\n"; - } - - my $validationKey = $this->_strikeone( $userAgent, $response ); - - $response = $userAgent->post( - "$this->{UPLOADTARGETSCRIPT}/login$this->{UPLOADTARGETSUFFIX}", - { - username => $user, - password => $pass, - validation_key => $validationKey - } - ); - - die 'Login failed ' - . $response->request->uri . ' -- ' - . $response->status_line . "\n" - . 'Aborting' . "\n" - unless $response->is_redirect - && $response->headers->header('Location') !~ m{/oops}; -} - -sub _strikeone { - my ( $this, $userAgent, $response ) = @_; - - my $f = $response->content(); - $f =~ s/<\/form>.*//sm; - $f =~ s/.*//sm; - my $validationKey; - while ( $f =~ /]*)>/g ) { - my $attrs = $1; - if ( $attrs =~ /\bname=["']validation_key["']/ - and $attrs =~ /\bvalue=["'](.*?)["']/ ) - { - $validationKey = $1; - last; - } - } - if ( not defined $validationKey ) { - warn "WARNING: The form does not have a validation_key field\n"; - return ''; - } - - my $cookie; - $userAgent->cookie_jar()->scan( - sub { - my ( $version, $key, $value ) = @_; - $cookie = $value if $key eq 'FOSWIKISTRIKEONE'; - } - ); - if ( not defined $cookie ) { - warn -"WARNING: Could not find strikeone cookie in cookiejar - disabling strikeone\n"; - return $validationKey; - } - - $validationKey =~ s/^\?//; - - return Digest::MD5::md5_hex( $validationKey . $cookie ); -} - -sub _uploadTopic { - my ( $this, $userAgent, $user, $pass, $topic, $form ) = @_; - - # send an edit request to get a validation key - my $response = $userAgent->get( -"$this->{UPLOADTARGETSCRIPT}/edit$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$topic" - ); - unless ( $response->is_success ) { - die 'Request to edit ' - . $this->{UPLOADTARGETWEB} . '/' - . $topic - . ' failed ' - . $response->request->uri . ' -- ' - . $response->status_line . "\n"; - } - - $form->{validation_key} = $this->_strikeone( $userAgent, $response ); - - $form->{text} =~ s/^%META:TOPICINFO{.*?\n//; # Delete any old topicinfo - my $url = -"$this->{UPLOADTARGETSCRIPT}/save$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$topic"; - $form->{text} = <{text}; - -EXTRA - print "Saving $topic\n"; - $this->_postForm( $userAgent, $user, $pass, $url, $form ); -} - -sub _uploadAttachment { - my ( $this, $userAgent, $user, $pass, $filename, $filepath, $filecomment, - $hide ) - = @_; - - # send an edit request to get a validation key - my $response = $userAgent->get( -"$this->{UPLOADTARGETSCRIPT}/edit$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$this->{project}" - ); - unless ( $response->is_success ) { - die 'Request to edit ' - . $this->{UPLOADTARGETWEB} . '/' - . $this->{project} - . ' failed ' - . $response->request->uri . ' -- ' - . $response->status_line . "\n"; - } - - my $url = -"$this->{UPLOADTARGETSCRIPT}/upload$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$this->{project}"; - my $form = [ - 'filename' => $filename, - 'filepath' => [$filepath], - 'filecomment' => $filecomment, - 'hidefile' => $hide || 0, - 'validation_key' => $this->_strikeone( $userAgent, $response ), - ]; - - print "Uploading $this->{UPLOADTARGETWEB}/$this->{project}/$filename\n"; - $this->_postForm( $userAgent, $user, $pass, $url, $form ); -} - -sub _postForm { - my ( $this, $userAgent, $user, $pass, $url, $form ) = @_; - - my $pause = $GLACIERMELT - ( time - $lastUpload ); - if ( $pause > 0 ) { - print "Taking a ${pause}s breather after the last upload...\n"; - sleep($pause); - } - $lastUpload = time(); - - my $response = - $userAgent->post( $url, $form, 'Content_Type' => 'form-data' ); - - die 'Upload failed ', $response->request->uri, - ' -- ', $response->status_line, "\n", 'Aborting', "\n", - $response->as_string - unless $response->is_redirect - && $response->headers->header('Location') !~ m{/oops|/log.n/}; -} - -sub _unhtml { - my $html = shift; - - $html =~ s/<[^<>]*>//og; - $html =~ s/&#?\w+;//go; - $html =~ s/\s//go; - - return $html; -} - -# Build POD documentation. This target defines =%$POD%= - it -# does not generate any output. The target will be invoked -# automatically if =%$POD%= is used in a .txt file. POD documentation -# is intended for use by developers only. - -# POD text in =.pm= files should use TML syntax or HTML. Packages should be -# introduced with a level 1 header, ---+, and each method in the package by -# a level 2 header, ---++. Make sure you document any global variables used -# by the module. - -sub target_POD { - my $this = shift; - $this->{POD} = ''; - local $/ = "\n"; - foreach my $file ( @{ $this->{files} } ) { - my $pmfile = $file->{name}; - if ( $pmfile =~ /\.p[ml]$/o ) { - next if $pmfile =~ /^$this->{project}_installer(\.pl)?$/; - $pmfile = $this->{basedir} . '/' . $pmfile; - open( PMFILE, '<', $pmfile ) || die $!; - my $inPod = 0; - while ( my $line = ) { - if ( $line =~ /^=(begin|pod)/ ) { - $inPod = 1; - } - elsif ( $line =~ /^=cut/ ) { - $inPod = 0; - } - elsif ($inPod) { - $this->{POD} .= $line; - } - } - close(PMFILE); - } - } -} - -=begin TML - ----++++ target_POD - -Print POD documentation. This target does not modify any files, it simply -prints the (TML format) POD. - -POD text in =.pm= files should use TML syntax or HTML. Packages should be -introduced with a level 1 header, ---+, and each method in the package by -a level 2 header, ---++. Make sure you document any global variables used -by the module. - -=cut - -sub target_pod { - my $this = shift; - $this->target_POD(); - print $this->{POD} . "\n"; -} - -=begin TML - ----++++ target_installer - -Write an install/uninstall script that checks dependencies, and optionally -downloads and installs required zips from foswiki.org. - -The install script is templated from =contrib/TEMPLATE_installer= and -is always named =module_installer= (where module is your module). It is -added to the release zip and is always shipped in the root directory. -It will automatically be added to the manifest if it doesn't appear in -MANIFEST. - -The install script works using the dependency type and version fields. -It will try to download from foswiki.org to satisfy any missing dependencies. -Downloaded modules are automatically installed. - -Note that the dependencies will only work if the module depended on follows -the naming standards for zips i.e. it must be attached to the topic in -foswiki.org and have the same name as the topic, and must be a zip file. - -Dependencies on CPAN modules are also checked (type perl) but no attempt -is made to install them. - -The install script also acts as an uninstaller and upgrade script. - -__Note__ that =target_install= builds and invokes this install script. - -At present there is no support for a caller-provided post-install script, but -this would be straightforward to do if it were required. - -=cut - -sub target_installer { - my $this = shift; - - return - if defined $this->{options}->{installers} - && $this->{options}->{installers} =~ /none/; - - # Add the install script to the manifest, unless it is already there - unless ( - grep( /^$this->{project}_installer$/, - map { $_->{name} } @{ $this->{files} } ) - ) - { - push( - @{ $this->{files} }, - { - name => $this->{project} . '_installer', - description => 'Install script', - permissions => 0770 - } - ); - warn 'Auto-adding install script to manifest', "\n" - if ( $this->{-v} ); - } - - # Find the template on @INC - my $template; - foreach my $d (@INC) { - my $dir = `dirname $d`; - chop($dir); - my $file = - $dir . '/lib/Foswiki/Contrib/BuildContrib/TEMPLATE_installer.pl'; - if ( -f $file ) { - $template = $file; - last; - } - $dir .= '/contrib'; - if ( -f $dir . '/TEMPLATE_installer.pl' ) { - $template = $dir . '/TEMPLATE_installer.pl'; - last; - } - } - unless ($template) { - die -'COULD NOT LOCATE TEMPLATE_installer.pl - required for install script generation'; - } - - my @sats; - foreach my $dep ( @{ $this->{dependencies} } ) { - my $descr = $dep->{description}; - $descr =~ s/"/\\\"/g; - $descr =~ s/\$/\\\$/g; - $descr =~ s/\@/\\\@/g; - $descr =~ s/\%/\\\%/g; - my $trig = $dep->{trigger}; - $trig = 1 unless ($trig); - push( @sats, -"{ name=>'$dep->{name}', type=>'$dep->{type}',version=>'$dep->{version}',description=>'$descr', trigger=>$trig }" - ); - } - my $satisfies = join( ",", @sats ); - $this->{SATISFIES} = $satisfies; - - my $installScript = - $this->{basedir} . '/' . $this->{project} . '_installer'; - if ( $this->{-v} || $this->{-n} ) { - print 'Generating installer in ', $installScript, "\n"; - } - - $this->filter_txt( $template, $installScript ); - - # Copy it to .pl - $this->cp( $installScript, "$installScript.pl" ); -} - -=begin TML - ----++++ build($target) -Build the given target - -=cut - -sub build { - my $this = shift; - my $target = shift; - - if ( $this->{-v} ) { - print 'Building ', $target, "\n"; - } - my $fn = 'target_' . $target; - no strict "refs"; - $this->$fn(); - use strict "refs"; - if ($@) { - die 'Failed to build ', $target, ': ', $@; - } - if ( $this->{-v} ) { - print 'Built ', $target, "\n"; - } -} - -=begin TML - ----++++ target_manifest -Generate and print to STDOUT a rough guess at the MANIFEST listing - -=cut - -sub target_manifest { - my $this = shift; - - $collector = $this; - my $manifest = _findRelativeTo( $buildpldir, 'MANIFEST' ); - if ( $manifest && -e $manifest ) { - open( F, '<', $manifest ) - || die 'Could not open existing ' . $manifest; - local $/ = undef; - %{ $collector->{manilist} } = - map { /^(.*?)(\s+.*)?$/; $1 => ( $2 || '' ) } split( /\r?\n/, ); - close(F); - } - else { - $manifest = $buildpldir . '/MANIFEST'; - } - require File::Find; - $collector->{manilist} = (); - warn "Gathering from $this->{basedir}\n"; - - File::Find::find( \&_manicollect, $this->{basedir} ); - print '# DRAFT ', $manifest, ' follows:', "\n"; - print '################################################', "\n"; - for ( sort keys %{ $collector->{manilist} } ) { - print $_. ' ' . $collector->{manilist}{$_} . "\n"; - } - print '################################################', "\n"; - print '# Copy and paste the text between the ###### lines into the file', - "\n"; - print '# ' . $manifest, "\n"; - print '# to create an initial manifest. Remove any files', "\n"; - print '# that should _not_ be released, and add a', "\n"; - print '# description of each file at the end of each line.', "\n"; -} - -sub _manicollect { - if (/^(CVS|\.svn|\.git)$/) { - $File::Find::prune = 1; - } - elsif ( - !-d - && /^\w.*\w$/ - && !/^(DEPENDENCIES|MANIFEST|(PRE|POST)INSTALL|build\.pl)$/ - && !/\.bak$/ - && !/^$collector->{project}_installer(\.pl)?$/ - - # Item10188: Ignore build output, but still want data/System/Project.txt - # $basedir in \Q...\E makes it a literal string (ignore regex chars) - && not $File::Find::name =~ - /\Q$basedir\E\W$collector->{project}\.(md5|zip|tgz|txt|sha1)$/ - ) - { - my $n = $File::Find::name; - my @a = stat($n); - my $perms = sprintf( "%04o", $a[2] & 0777 ); - $n =~ s/$collector->{basedir}\/?//; - $collector->{manilist}{$n} = $perms - unless exists $collector->{manilist}{$n}; - } -} - -=begin TML - -#HistoryTarget -Updates the history in the plugin/contrib topic from the subversion checkin history. - * Requires a line like | Change History:| NNNN: descr | in the topic, where NNN is an SVN rev no and descr is the description of the checkin. - * Automatically changes ItemNNNN references to links to the bugs web. - * Must be run in a subversion checkout area! -This target works in the current checkout area; it still requires a checkin of the updated plugin. Note that history items checked in against Item000 are *ignored* (not included in the history). - -=cut - -sub target_history { - my $this = shift; - - my $f = $this->{basedir} . '/' . $this->{topic_root} . '.txt'; - - my $cmd = "cd $this->{basedir} && svn status"; - warn "Checking status using $cmd\n"; - my $log = join( "\n", grep { !/^\?/ } split( /\n/, `$cmd` ) ); - warn "WARNING:\n$log\n" if $log; - - open( IN, '<', $f ) or die "Could not open $f: $!"; - - # find the table - my $in_history = 0; - my @history; - my $pre = ''; - my $post; - local $/ = "\n"; - while ( my $line = ) { - if ( $line =~ - /^\s*\|\s*Change(?:\s+| )History:.*?\|\s*(.*?)\s*\|\s*$/i ) - { - $in_history = 1; - push( @history, [ "?1'$1'", $1 ] ) if ( $1 && $1 !~ /^\s*$/ ); - } - elsif ($in_history) { - - # | NNNN | desc | - if ( $line =~ /^\s*\|\s*(\d+)\s*\|\s*(.*?)\s*\|\s*$/ ) { - push( @history, [ $1, $2 ] ); - } - - # | date | desc | - elsif ( $line =~ - /^\s*\|\s*(\d+[-\s\/]+\w+[-\s+\/]\d+)\s*\|\s*(.*?)\s*\|\s*$/ ) - { - push( @history, [ $1, $2 ] ); - } - - # | verno | desc | - elsif ( $line =~ /^\s*\|\s*([\d.]+)\s*\|\s*(.*?)\s*\|\s*$/ ) { - push( @history, [ $1, $2 ] ); - } - - # | | date: desc | - elsif ( - $line =~ /^\s*\|\s*\|\s*(\d+\s+\w+\s+\d+):\s*(.*?)\s*\|\s*$/ ) - { - push( @history, [ $1 . $2 ] ); - } - - # | | verno: desc | - elsif ( $line =~ /^\s*\|\s*\|\s*([\d.]+):\s*(.*?)\s*\|\s*$/ ) { - push( @history, [ $1, $2 ] ); - } - - # | | desc | - elsif ( $line =~ /^\s*\|\s*\|\s*(.*?)\s*\|\s*$/ ) { - push( @history, [ "?" . $1 ] ); - } - - else { - $post = $line; - last; - } - } - else { - $pre .= $line; - } - } - die "No | Change History: | ... | found" unless $in_history; - $/ = undef; - $post .= ; - close(IN); - - # Determine the most recent history item - my $base = 0; - if ( scalar(@history) && $history[0]->[0] =~ /^(\d+)$/ ) { - $base = $1; - } - warn "Refreshing history since $base\n"; - $cmd = "cd $this->{basedir} && svn info -R"; - warn "Recovering version info using $cmd...\n"; - $log = `$cmd`; - - # find files with revs more recent than $base - my $curpath; - my @revs; - foreach my $line ( split( /\n/, $log ) ) { - if ( $line =~ /^Path: (.*)$/ ) { - $curpath = $1; - } - elsif ( $line =~ /^Last Changed Rev: (.*)$/ ) { - die unless $curpath; - if ( $1 > $base ) { - warn "$curpath $1 > $base\n"; - push( @revs, $curpath ); - } - $curpath = undef; - } - } - - unless ( scalar(@revs) ) { - warn "History is up to date with svn log\n"; - return; - } - - # Update the history - $cmd = "cd $this->{basedir} && svn log " . join( ' && svn log ', @revs ); - warn "Updating history using $cmd...\n"; - $log = `$cmd`; - my %new; - foreach my $line ( split( /^----+\s*/m, $log ) ) { - if ( $line =~ - /^r(\d+)\s*\|\s*(\w+)\s*\|\s*.*?\((.+?)\)\s*\|.*?\n\s*(.+?)\s*$/ ) - { - - # Ignore the history item we already have - next if $1 == $base; - my $rev = $1; - next if $rev <= $base; - my $when = "$2 $3 "; - my $mess = $4; - - # Ignore Item000: checkins - next if $mess =~ /^Item0+:/; - $mess =~ s/ $a } keys(%new) ); - print "| Change History: | |\n"; - print join( "\n", map { "| $_->[0] | $_->[1] |" } @history ); -} - -=begin TML - ----++++ target_dependencies - -Extract and print all dependencies, in standard DEPENDENCIES syntax. -Requires B::PerlReq. Analyses perl sources in !includes as well. - -All dependencies except those on pragmas (strict, integer etc) are -extracted. - -=cut - -sub target_dependencies { - my $this = shift; - local $/ = "\n"; - - die "B::PerlReq is required for 'dependencies': $@" - unless eval "use B::PerlReq; 1"; - - foreach my $m ( - 'strict', 'vars', 'diagnostics', 'base', - 'bytes', 'constant', 'integer', 'locale', - 'overload', 'warnings', 'Assert', 'TWiki', - 'Foswiki' - ) - { - $this->{satisfied}{$m} = 1; - } - - # See if we already know about it - foreach my $dep ( @{ $this->{dependencies} } ) { - $this->{satisfied}{ $dep->{name} } = 1; - } - - $this->{extracted_deps} = undef; - my @queue; - my %tainted; - foreach my $file ( @{ $this->{files} } ) { - my $is_perl = 0; - my $pmfile = $file->{name}; - if ( $pmfile =~ /\.p[ml]$/o - && $pmfile !~ /build.pl/ - && $pmfile !~ /TEMPLATE_installer.pl/ ) - { - $is_perl = 1; - } - else { - my $testfile = $this->{basedir} . '/' . $pmfile; - if ( -e $testfile ) { - open( PMFILE, '<', $testfile ) || die "$testfile: $!"; - my $fline = ; - if ( $fline && $fline =~ m.#!/usr/bin/perl. ) { - $is_perl = 1; - $tainted{$pmfile} = '-T' if $fline =~ /-T/; - } - close(PMFILE); - } - } - if ( $pmfile =~ /^lib\/(.*)\.pm$/ ) { - my $f = $1; - $f =~ s.CPAN/lib/..; - $f =~ s./.::.g; - $this->{satisfied}{$f} = 1; - } - if ($is_perl) { - $tainted{$pmfile} = '' unless defined $tainted{$pmfile}; - push( @queue, $pmfile ); - } - } - - my $inc = '-I' . join( ' -I', @INC ); - foreach my $pmfile (@queue) { - die unless defined $basedir; - die unless defined $inc; - die unless defined $pmfile; - die $pmfile unless defined $tainted{$pmfile}; - my $deps = -`cd $basedir && perl $inc $tainted{$pmfile} -MO=PerlReq,-strict $pmfile 2>/dev/null`; - $deps =~ s/perl\((.*?)\)/$this->_addDep($pmfile, $1)/ge if $deps; - } - - print "MISSING DEPENDENCIES:\n"; - my $depcount = 0; - foreach my $module ( sort keys %{ $this->{extracted_deps} } ) { - print "$module,>=0,cpan,May be required for " - . join( ', ', @{ $this->{extracted_deps}{$module} } ) . "\n"; - $depcount++; - } - print $depcount - . ' missing dependenc' - . ( $depcount == 1 ? 'y' : 'ies' ) . "\n"; -} - -sub _addDep { - my ( $this, $from, $file ) = @_; - - $file =~ s./.::.g; - $file =~ s/\.pm$//; - return '' if $this->{satisfied}{$file}; - push( @{ $this->{extracted_deps}{$file} }, $from ); - return ''; -} - -our @twikiFilters = ( - { RE => qr/\.pm$/, filter => '_twikify_perl' }, - { RE => qr/\.pm$/, filter => '_twikify_txt' }, - { RE => qr#/Config.spec$#, filter => '_twikify_perl' }, - { RE => qr#/MANIFEST$#, filter => '_twikify_manifest' }, - { RE => qr#/DEPENDENCIES$#, filter => '_twikify_perl' }, -); - -# Create a TWiki version of the extension by simple transformation of files. -# Useless for processing CSS, JS or anything else complex. -sub target_twiki { - my $this = shift; - - print STDERR <{basedir}/##; - push( @{ $this->{files} }, { name => "$r/MANIFEST" } ); - push( @{ $this->{files} }, { name => "$r/DEPENDENCIES" } ); - push( @{ $this->{files} }, { name => "$r/build.pl" } ); - - foreach my $file ( @{ $this->{files} } ) { - my $nf = $file->{name}; - if ( $file->{name} =~ m#^(data|pub)/System/(.*)$# ) { - $nf = "$1/TWiki/$2"; - } - elsif ( $file->{name} =~ m#^lib/Foswiki/(.*)$# ) { - $nf = "lib/TWiki/$1"; - } - if ( $nf ne $file->{name} ) { - my $filtered = 0; - foreach my $filter (@twikiFilters) { - if ( $file->{name} =~ /$filter->{RE}/ ) { - my $fn = $filter->{filter}; - $this->$fn( $this->{basedir} . '/' . $file->{name}, - $this->{basedir} . '/' . $nf ); - $filtered = 1; - last; - } - } - unless ($filtered) { - $this->cp( $this->{basedir} . '/' . $file->{name}, - $this->{basedir} . '/' . $nf ); - } - $file->{name} = $nf; - print "Created $file->{name}\n"; - } - } -} - -sub _twikify_perl { - my ( $this, $from, $to ) = @_; - - $this->_filter_file( - $from, $to, - sub { - my ( $this, $text ) = @_; - $text =~ s/Foswiki::/TWiki::/g; - $text =~ s/new Foswiki\s*\(\s*\);/new TWiki();/g; - $text =~ s/\b(use|require)\s+Foswiki/$1 TWiki/g; - $text =~ s/foswiki\([A-Z][A-Za-z]\+\)/twiki$1/g; - $text =~ s/'foswiki'/'twiki'/g; - $text =~ s/FOSWIKI_/TWIKI_/g; - $text =~ s/foswikiNewLink/twikiNewLink/g; # CSS - $text =~ s/foswikiAlert/twikiAlert/g; - $text =~ s/new Foswiki/new TWiki/g; - return <<'CAVEAT' . $text; -# This TWiki version was auto-generated from Foswiki sources by BuildContrib. -# Copyright (C) 2008-2010 Foswiki Contributors - -CAVEAT - - # Note: the last blank line is to avoid mangling =pod - } - ); -} - -sub _twikify_manifest { - my ( $this, $from, $to ) = @_; - - $this->_filter_file( - $from, $to, - sub { - my ( $this, $text ) = @_; - $text =~ s#^data/System#data/TWiki#gm; - $text =~ s#^pub/System#pub/TWiki#gm; - $text =~ s#^lib/Foswiki#lib/TWiki#gm; - return <_filter_file( - $from, $to, - sub { - my ( $this, $text ) = @_; - return < -This TWiki version was auto-generated from Foswiki sources by BuildContrib. -
-Copyright (C) 2008-2010 Foswiki Contributors - -$text -HERE - } - ); } 1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/BaseBuild.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/BaseBuild.pm index 8e72d1303a..b3c3eb5359 100755 --- a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/BaseBuild.pm +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/BaseBuild.pm @@ -15,6 +15,8 @@ package Foswiki::Contrib::BuildContrib::BaseBuild; use strict; +use warnings; +use Digest::MD5; =begin foswiki @@ -69,7 +71,8 @@ sub readManifest { #print STDERR "---- $baseDir, $path, $file\n"; - unless ( $file && open( PF, '<' . $file ) ) { + my $pf; + unless ( $file && open( $pf, '<', $file ) ) { print STDERR 'COULD NOT OPEN MANIFEST FILE ', $file, $NL; &$noManifestFileHook() if defined($noManifestFileHook) @@ -81,7 +84,8 @@ sub readManifest { my $line; my $noci = 0; my %options; - while ( $line = ) { + my $md5 = Digest::MD5->new; + while ( $line = <$pf> ) { next if $line =~ /^\s*(?:#|$)/; if ( $line =~ /^!include\s+(\S+)\s*$/ ) { push( @otherModules, $1 ); @@ -96,10 +100,10 @@ sub readManifest { $noci = 0; } elsif ( $line =~ /^(".*"|\S+)\s+(0?\d\d\d)?\s*(\S.*)?\s*$/o ) { - my $name = $1; - $name =~ s/^"(.*)"$/$1/; + my ( $name, $quotedName ) = ( $1, $1 ); my $permissions = $2; my $desc = $3 || ''; + $name =~ s/^"(.*)"$/$1/; if ( $noci && $desc !~ /\(noci\)/ ) { $desc .= " (noci)"; } @@ -133,13 +137,27 @@ sub readManifest { $permissions =~ s/^0+/0/; my $n = { name => $name, + quotedName => $quotedName, description => ( $desc || '' ), - permissions => $permissions + permissions => $permissions, + md5 => '', }; + if ( -f "$baseDir/$name" ) { + $md5->new; + open my $fh, '<', "$baseDir/$name" + or die "Can't open $baseDir/$name: $!"; + binmode $fh; + $md5->addfile($fh); + close $fh; + $n->{md5} = $md5->hexdigest; + } + else { + warn "File $name does not exist on disk!"; + } push( @files, $n ); } } - close(PF); + close $pf; return ( \@files, \@otherModules, \%options ); } diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/MANIFEST b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/MANIFEST index 14d96d15b5..2302751e34 100755 --- a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/MANIFEST +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/MANIFEST @@ -3,7 +3,24 @@ data/System/BuildContrib.txt 0444 Description lib/Foswiki/Contrib/Build.pm 0444 Code module lib/Foswiki/Contrib/BuildContrib.pm 0444 Dummy module for version strings lib/Foswiki/Contrib/BuildContrib/BaseBuild.pm 0444 Common functionality for build programs -lib/Foswiki/Contrib/BuildContrib/build.pl 0555 Build script +lib/Foswiki/Contrib/BuildContrib/build.pl 0444 Build script +lib/Foswiki/Contrib/BuildContrib/Targets/manifest.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/tidy.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/tracked.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/release.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/stage.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/compress.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/test.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/upload.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/twiki.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/archive.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/history.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/install.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/uninstall.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/handsoff_install.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/dependencies.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/installer.pm 0444 +lib/Foswiki/Contrib/BuildContrib/Targets/POD.pm 0444 lib/Foswiki/Contrib/BuildContrib/TEMPLATE_installer.pl 0444 Installer template pub/System/BuildContrib/logo.gif 0444 Image create_new_extension.pl 0555 Wizard for creating new extensions diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/POD.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/POD.pm new file mode 100644 index 0000000000..db92a9f1fc --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/POD.pm @@ -0,0 +1,55 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +# Build POD documentation. This target defines =%$POD%= - it +# does not generate any output. The target will be invoked +# automatically if =%$POD%= is used in a .txt file. POD documentation +# is intended for use by developers only. + +# POD text in =.pm= files should use TML syntax or HTML. Packages should be +# introduced with a level 1 header, ---+, and each method in the package by +# a level 2 header, ---++. Make sure you document any global variables used +# by the module. + +sub target_POD { + my $this = shift; + $this->{POD} = ''; + local $/ = "\n"; + foreach my $file ( @{ $this->{files} } ) { + my $pmfile = $file->{name}; + if ( $pmfile =~ /\.p[ml]$/o ) { + next if $pmfile =~ /^$this->{project}_installer(\.pl)?$/; + $pmfile = $this->{basedir} . '/' . $pmfile; + open( PMFILE, '<', $pmfile ) || die $!; + my $inPod = 0; + while ( my $line = ) { + if ( $line =~ /^=(begin|pod)/ ) { + $inPod = 1; + } + elsif ( $line =~ /^=cut/ ) { + $inPod = 0; + } + elsif ($inPod) { + $this->{POD} .= $line; + } + } + close(PMFILE); + } + } +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/archive.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/archive.pm new file mode 100644 index 0000000000..9593c6be87 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/archive.pm @@ -0,0 +1,155 @@ +# See bottom of file for license and copyright information +package Foswiki::Contrib::Build; + +use strict; +use warnings; +use Digest::MD5; + +=begin TML + +---++++ target_archive +Makes zip and tgz archives of the files in tmpDir. Also copies the installer. + +=cut + +sub target_archive { + my $this = shift; + my $project = $this->{project}; + my $target = $project; + if ( defined $this->{options}->{archive_prefix} ) { + + # optional archive name prefix + $target = "$this->{options}->{archive_prefix}$target"; + } + + die 'no tmpDir set' unless defined( $this->{tmpDir} ); + die 'no project set' unless defined($project); + die 'tmpDir (' . $this->{tmpDir} . ') not found' + unless ( -e $this->{tmpDir} ); + + $this->pushd( $this->{tmpDir} ); + + $this->apply_perms( $this->{files}, $this->{tmpDir} ); + + $this->sys_action( 'zip', '-r', '-q', $project . '.zip', '*' ); + $this->perl_action( 'File::Copy::move("' + . $project + . '.zip", "' + . $this->{basedir} . '/' + . $target + . '.zip");' ); + + # BSD and MacOS don't support owner/group options. + if ( `tar --owner 2>&1` =~ m/(?:unrecognized|not supported)/ ) { + +# SMELL: sys_action will auto quote any parameter containing a space. So the parameter +# and argument for group and user must be passed in as separate parameters. + print STDERR + "tar --owner / --group not supported. Recommend building as root\n"; + $this->sys_action( 'tar', '-czhpf', $project . '.tgz', '*' ); + } + else { + $this->sys_action( 'tar', '--owner', '0', '--group', '0', '-czhpf', + $project . '.tgz', '*' ); + } + + $this->perl_action( 'File::Copy::move("' + . $project + . '.tgz", "' + . $this->{basedir} . '/' + . $target + . '.tgz")' ); + + $this->perl_action( 'File::Copy::move("' + . $this->{tmpDir} . '/' + . $project + . '_installer","' + . $this->{basedir} . '/' + . $target + . '_installer")' ); + + $this->pushd( $this->{basedir} ); + my @fs; + foreach my $f (qw(.tgz _installer .zip)) { + push( @fs, "$target$f" ) if ( -e "$target$f" ); + } + + open( my $cs, '>', "$target.md5" ) || die $!; + my $md5 = Digest::MD5->new; + foreach my $file (@fs) { + $md5->new; + open my $fh, '<', $file + or die "Can't open $file: $!"; + binmode $fh; + $md5->addfile($fh); + close $fh; + print $cs $md5->hexdigest . " $file\n"; + } + close(CS); + print "MD5 checksums in $this->{basedir}/$target.md5\n"; + + if ( eval { require Digest::SHA } ) { + open( CS, '>', "$target.sha1" ) || die $!; + foreach my $file (@fs) { + open( F, '<', $file ); + local $/; + my $data = ; + close(F); + my $cs = Digest::SHA::sha1_hex($data); + print CS "$cs $file\n"; + } + close(CS); + print "SHA1 checksums in $this->{basedir}/$target.sha1\n"; + } + else { + warn + "WARNING: Digest::SHA not installed; cannot generate SHA1 checksum\n"; + } + + $this->popd(); + $this->popd(); + + my $warn = 0; + foreach my $f (qw(.tgz .zip .txt _installer)) { + if ( -e "$this->{basedir}/$target$f" ) { + print "$f in $this->{basedir}/$target$f\n"; + } + else { + warn "WARNING: no $target$f was generated\n"; + $warn++; + } + } + if ($warn) { + warn < qr/\.js$/, filter => '_build_js' }, + { RE => qr/\.css$/, filter => '_build_css' }, + { RE => qr/\.gz$/, filter => '_build_gz' }, +); + +=begin TML + +---++++ target_compress +Compress Javascript and CSS files. This target is "best efforts" - the build +won't fail if a source or target isn't missing. + +=cut + +sub target_compress { + my $this = shift; + my %file_ok; + foreach my $filter (@compressFilters) { + FILE: + foreach my $file ( @{ $this->{files} } ) { + next FILE if $file_ok{$file}; + + # Find files that match the build filter and try to update + # them + if ( $file->{name} =~ /$filter->{RE}/ ) { + my $fn = $filter->{filter}; + $file_ok{$file} = + $this->$fn( $this->{basedir} . '/' . $file->{name} ); + } + } + } +} + +# Uses JavaScript::Minifier to optimise javascripts +# Several different name mappings are supported: +# * XXX.uncompressed.js -> XXX.js +# * XXX_src.js -> XXX.js +# * XXX.uncompressed.js -> XXX.compressed.js +# +# These are selected between depending on which exist on disk. +sub _build_js { + my ( $this, $to ) = @_; + + if ( !$minifiers{js} ) { + my $yui = _haveYUI(); + + if ($yui) { + $minifiers{js} = sub { + return $this->_yuiMinify( @_, 'js', $yui ); + }; + } + } + + # If no good, try the CPAN minifiers + if ( !$minifiers{js} && eval { require JavaScript::Minifier::XS; 1 } ) { + $minifiers{js} = sub { + return $this->_cpanMinify( @_, \&JavaScript::Minifier::XS::minify ); + }; + } + if ( !$minifiers{js} && eval { require JavaScript::Minifier; 1 } ) { + $minifiers{js} = sub { + return $this->_cpanMinify( + @_, + sub { + JavaScript::Minifier::minify( input => $_[0] ); + } + ); + }; + } + if ( !$minifiers{js} ) { + warn "Cannot squish $to: no minifier found\n"; + return; + } + + return $this->_build_compress( 'js', $to ); +} + +# Uses CSS::Minifier to optimise CSS files +# +# Several different name mappings are supported: +# * XXX.uncompressed.css -> XXX.css +# * XXX_src.css -> XXX.css +# * XXX.uncompressed.css -> XXX.compressed.css + +sub _build_css { + my ( $this, $to ) = @_; + + if ( !$minifiers{css} ) { + my $yui = _haveYUI(); + + if ($yui) { + $minifiers{css} = sub { + return $this->_yuiMinify( @_, 'css', $yui ); + }; + } + } + if ( !$minifiers{css} && eval { require CSS::Minifier::XS; 1 } ) { + $minifiers{css} = sub { + return $this->_cpanMinify( @_, \&CSS::Minifier::XS::minify ); + }; + } + if ( !$minifiers{css} && eval { require CSS::Minifier; 1 } ) { + $minifiers{css} = sub { + $this->_cpanMinify( + @_, + sub { + CSS::Minifier::minify( input => $_[0] ); + } + ); + }; + } + + return $this->_build_compress( 'css', $to ); +} + +sub _needsBuilding { + my ( $from, $to ) = @_; + + if ( -e $to ) { + my @fstat = stat($from); + my @tstat = stat($to); + return 0 if ( $tstat[9] >= $fstat[9] ); + } + return 1; +} + +# Guess the name mapping for .js or .css +sub _deduceCompressibleSrc { + my ( $this, $to, $ext ) = @_; + my $from; + + if ( $to =~ /^(.*)\.compressed\.$ext$/ ) { + if ( -e "$1.uncompressed.$ext" ) { + $from = "$1.uncompressed.$ext"; + } + elsif ( -e "$1_src\.$ext" ) { + $from = "$1_src.$ext"; + } + else { + $from = "$1.$ext"; + } + } + elsif ( $to =~ /^(.*)\.$ext$/ ) { + if ( -e "$1.uncompressed.$ext" ) { + $from = "$1.uncompressed.$ext"; + } + else { + $from = "$1_src.$ext"; + } + } + return $from; +} + +sub _build_compress { + my ( $this, $type, $to ) = @_; + + if ( !$minifiers{$type} ) { + warn "Cannot squish $to: no minifier found for $type\n"; + return; + } + + my $from = $this->_deduceCompressibleSrc( $to, $type ); + unless ( -e $from ) { + + # There may be a good reason there is no minification source; + # for example, it might not be a derived object. + #warn "Minification source for $to not found\n"; + return; + } + if ( -l $to ) { + + # BuildContrib will always override links created by pseudo-install + unlink($to); + } + unless ( _needsBuilding( $from, $to ) ) { + if ( $this->{-v} || $this->{-n} ) { + warn "$to is up-to-date\n"; + } + return; + } + + if ( !$this->{-n} ) { + &{ $minifiers{$type} }( $from, $to ); + warn "Generated $to from $from\n"; + } + else { + warn "Minify $from to $to\n"; + } +} + +# Uses Compress::Zlib to gzip files +# +# * xxx.yyy -> xxx.yyy.gz +# + +sub _build_gz { + my ( $this, $to ) = @_; + + unless ( eval { require Compress::Zlib } ) { + warn "Cannot gzip: $@\n"; + return 0; + } + + my $from = $to; + $from =~ s/\.gz$// or return 0; + return 0 unless -e $from && _needsBuilding( $from, $to ); + + if ( -l $to ) { + + # BuildContrib will always override links created by pseudo-install + unlink($to); + } + + my $f; + open( $f, '<', $from ) || die $!; + local $/ = undef; + my $text = <$f>; + close($f); + + $text = Compress::Zlib::memGzip($text); + + unless ( $this->{-n} ) { + my $f; + open( $f, '>', $to ) || die "$to: $!"; + binmode $f; + print $f $text; + close($f); + warn "Generated $to from $from\n"; + } + return 1; +} + +# helper functions for calling minifiers +sub _cpanMinify { + my ( $this, $from, $to, $fn ) = @_; + my $f; + open( $f, '<', $from ) || die $!; + local $/ = undef; + my $text = <$f>; + close($f); + + $text = &$fn($text); + + if ( open( $f, '<', $to ) ) { + my $ot = <$f>; + close($f); + if ( $text eq $ot ) { + + #warn "$to is up to date w.r.t $from\n"; + return 1; # no changes + } + } + + open( $f, '>', $to ) || die "$to: $!"; + print $f $text; + close($f); +} + +sub _yuiMinify { + my ( $this, $from, $to, $type, $cmdtype ) = @_; + my $lcall = $ENV{'LC_ALL'}; + my $cmd; + + if ( $cmdtype == 2 ) { + $cmd = "java -jar $basedir/tools/yuicompressor.jar --type $type $from"; + } + else { + $cmd = "yui-compressor --type $type $from"; + } + unless ( $this->{-n} ) { + $cmd .= " -o $to"; + } + + warn "$cmd\n"; + my $out = `$cmd`; + $ENV{'LC_ALL'} = $lcall; + return $out; +} + +=begin TML + +---++++ _haveYUI +return 1 if we have YUI as a command yui-compressor +return 2 if we have YUI as a jar file in tools + +=cut + +sub _haveYUI { + my $info = `yui-compressor -h 2>&1`; + my $result = 0; + + if ( not $? ) { + $result = 1; + } + elsif ( -e "$basedir/tools/yuicompressor.jar" ) { + + # Do we have java? + $info = `java -version 2>&1` || ''; + if ( not $? ) { + $result = 2; + } + } + + return $result; +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/dependencies.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/dependencies.pm new file mode 100644 index 0000000000..3bf8e37620 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/dependencies.pm @@ -0,0 +1,120 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +use B::PerlReq; + +=begin TML + +---++++ target_dependencies + +Extract and print all dependencies, in standard DEPENDENCIES syntax. +Requires B::PerlReq. Analyses perl sources in !includes as well. + +All dependencies except those on pragmas (strict, integer etc) are +extracted. + +=cut + +sub target_dependencies { + my $this = shift; + local $/ = "\n"; + + foreach my $m ( + 'strict', 'vars', 'diagnostics', 'base', + 'bytes', 'constant', 'integer', 'locale', + 'overload', 'warnings', 'Assert', 'TWiki', + 'Foswiki' + ) + { + $this->{satisfied}{$m} = 1; + } + + # See if we already know about it + foreach my $dep ( @{ $this->{dependencies} } ) { + $this->{satisfied}{ $dep->{name} } = 1; + } + + $this->{extracted_deps} = undef; + my @queue; + my %tainted; + foreach my $file ( @{ $this->{files} } ) { + my $is_perl = 0; + my $pmfile = $file->{name}; + if ( $pmfile =~ /\.p[ml]$/o + && $pmfile !~ /build.pl/ + && $pmfile !~ /TEMPLATE_installer.pl/ ) + { + $is_perl = 1; + } + else { + my $testfile = $this->{basedir} . '/' . $pmfile; + if ( -e $testfile ) { + open( PMFILE, '<', $testfile ) || die "$testfile: $!"; + my $fline = ; + if ( $fline && $fline =~ m.#!/usr/bin/perl. ) { + $is_perl = 1; + $tainted{$pmfile} = '-T' if $fline =~ /-T/; + } + close(PMFILE); + } + } + if ( $pmfile =~ /^lib\/(.*)\.pm$/ ) { + my $f = $1; + $f =~ s.CPAN/lib/..; + $f =~ s./.::.g; + $this->{satisfied}{$f} = 1; + } + if ($is_perl) { + $tainted{$pmfile} = '' unless defined $tainted{$pmfile}; + push( @queue, $pmfile ); + } + } + + my $inc = '-I' . join( ' -I', @INC ); + foreach my $pmfile (@queue) { + die unless defined $basedir; + die unless defined $inc; + die unless defined $pmfile; + die $pmfile unless defined $tainted{$pmfile}; + my $deps = +`cd $basedir && perl $inc $tainted{$pmfile} -MO=PerlReq,-strict $pmfile 2>/dev/null`; + $deps =~ s/perl\((.*?)\)/$this->_addDep($pmfile, $1)/ge if $deps; + } + + print "MISSING DEPENDENCIES:\n"; + my $depcount = 0; + foreach my $module ( sort keys %{ $this->{extracted_deps} } ) { + print "$module,>=0,cpan,May be required for " + . join( ', ', @{ $this->{extracted_deps}{$module} } ) . "\n"; + $depcount++; + } + print $depcount + . ' missing dependenc' + . ( $depcount == 1 ? 'y' : 'ies' ) . "\n"; +} + +sub _addDep { + my ( $this, $from, $file ) = @_; + + $file =~ s./.::.g; + $file =~ s/\.pm$//; + return '' if $this->{satisfied}{$file}; + push( @{ $this->{extracted_deps}{$file} }, $from ); + return ''; +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/handsoff_install.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/handsoff_install.pm new file mode 100644 index 0000000000..b27fada283 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/handsoff_install.pm @@ -0,0 +1,42 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +=begin TML + +---++++ target_handsoff_install +Install target, installs to local install pointed at by FOSWIKI_HOME. + +Does not run the installer script. + +=cut + +sub target_handsoff_install { + my $this = shift; + $this->build('release'); + + my $home = $ENV{FOSWIKI_HOME}; + die 'FOSWIKI_HOME not set' unless $home; + $this->pushd($home); + $this->sys_action( 'tar', 'zxpf', + $this->{basedir} . '/' . $this->{project} . '.tgz' ); + + # kill off the module installer + $this->rm( $home . '/' . $this->{project} . '_installer' ); + $this->popd(); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/history.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/history.pm new file mode 100644 index 0000000000..cfd938511c --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/history.pm @@ -0,0 +1,167 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +=begin TML + +#HistoryTarget +Updates the history in the plugin/contrib topic from the subversion checkin history. + * Requires a line like | Change History:| NNNN: descr | in the topic, where NNN is an SVN rev no and descr is the description of the checkin. + * Automatically changes ItemNNNN references to links to the bugs web. + * Must be run in a subversion checkout area! +This target works in the current checkout area; it still requires a checkin of the updated plugin. Note that history items checked in against Item000 are *ignored* (not included in the history). + +=cut + +sub target_history { + my $this = shift; + + my $f = $this->{basedir} . '/' . $this->{topic_root} . '.txt'; + + my $cmd = "cd $this->{basedir} && svn status"; + warn "Checking status using $cmd\n"; + my $log = join( "\n", grep { !/^\?/ } split( /\n/, `$cmd` ) ); + warn "WARNING:\n$log\n" if $log; + + open( IN, '<', $f ) or die "Could not open $f: $!"; + + # find the table + my $in_history = 0; + my @history; + my $pre = ''; + my $post; + local $/ = "\n"; + while ( my $line = ) { + if ( $line =~ + /^\s*\|\s*Change(?:\s+| )History:.*?\|\s*(.*?)\s*\|\s*$/i ) + { + $in_history = 1; + push( @history, [ "?1'$1'", $1 ] ) if ( $1 && $1 !~ /^\s*$/ ); + } + elsif ($in_history) { + + # | NNNN | desc | + if ( $line =~ /^\s*\|\s*(\d+)\s*\|\s*(.*?)\s*\|\s*$/ ) { + push( @history, [ $1, $2 ] ); + } + + # | date | desc | + elsif ( $line =~ + /^\s*\|\s*(\d+[-\s\/]+\w+[-\s+\/]\d+)\s*\|\s*(.*?)\s*\|\s*$/ ) + { + push( @history, [ $1, $2 ] ); + } + + # | verno | desc | + elsif ( $line =~ /^\s*\|\s*([\d.]+)\s*\|\s*(.*?)\s*\|\s*$/ ) { + push( @history, [ $1, $2 ] ); + } + + # | | date: desc | + elsif ( + $line =~ /^\s*\|\s*\|\s*(\d+\s+\w+\s+\d+):\s*(.*?)\s*\|\s*$/ ) + { + push( @history, [ $1 . $2 ] ); + } + + # | | verno: desc | + elsif ( $line =~ /^\s*\|\s*\|\s*([\d.]+):\s*(.*?)\s*\|\s*$/ ) { + push( @history, [ $1, $2 ] ); + } + + # | | desc | + elsif ( $line =~ /^\s*\|\s*\|\s*(.*?)\s*\|\s*$/ ) { + push( @history, [ "?" . $1 ] ); + } + + else { + $post = $line; + last; + } + } + else { + $pre .= $line; + } + } + die "No | Change History: | ... | found" unless $in_history; + $/ = undef; + $post .= ; + close(IN); + + # Determine the most recent history item + my $base = 0; + if ( scalar(@history) && $history[0]->[0] =~ /^(\d+)$/ ) { + $base = $1; + } + warn "Refreshing history since $base\n"; + $cmd = "cd $this->{basedir} && svn info -R"; + warn "Recovering version info using $cmd...\n"; + $log = `$cmd`; + + # find files with revs more recent than $base + my $curpath; + my @revs; + foreach my $line ( split( /\n/, $log ) ) { + if ( $line =~ /^Path: (.*)$/ ) { + $curpath = $1; + } + elsif ( $line =~ /^Last Changed Rev: (.*)$/ ) { + die unless $curpath; + if ( $1 > $base ) { + warn "$curpath $1 > $base\n"; + push( @revs, $curpath ); + } + $curpath = undef; + } + } + + unless ( scalar(@revs) ) { + warn "History is up to date with svn log\n"; + return; + } + + # Update the history + $cmd = "cd $this->{basedir} && svn log " . join( ' && svn log ', @revs ); + warn "Updating history using $cmd...\n"; + $log = `$cmd`; + my %new; + foreach my $line ( split( /^----+\s*/m, $log ) ) { + if ( $line =~ + /^r(\d+)\s*\|\s*(\w+)\s*\|\s*.*?\((.+?)\)\s*\|.*?\n\s*(.+?)\s*$/ ) + { + + # Ignore the history item we already have + next if $1 == $base; + my $rev = $1; + next if $rev <= $base; + my $when = "$2 $3 "; + my $mess = $4; + + # Ignore Item000: checkins + next if $mess =~ /^Item0+:/; + $mess =~ s/ $a } keys(%new) ); + print "| Change History: | |\n"; + print join( "\n", map { "| $_->[0] | $_->[1] |" } @history ); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/install.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/install.pm new file mode 100644 index 0000000000..77302893db --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/install.pm @@ -0,0 +1,33 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +=begin TML + +---++++ target_install +Install target, installs to local twiki pointed at by FOSWIKI_HOME. + +Uses the installer script written by target_installer + +=cut + +sub target_install { + my $this = shift; + $this->build('handsoff_install'); + $this->sys_action( 'perl', $this->{project} . '_installer', 'install' ); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/installer.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/installer.pm new file mode 100644 index 0000000000..5d88bf2a75 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/installer.pm @@ -0,0 +1,126 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +=begin TML + +---++++ target_installer + +Write an install/uninstall script that checks dependencies, and optionally +downloads and installs required zips from foswiki.org. + +The install script is templated from =contrib/TEMPLATE_installer= and +is always named =module_installer= (where module is your module). It is +added to the release zip and is always shipped in the root directory. +It will automatically be added to the manifest if it doesn't appear in +MANIFEST. + +The install script works using the dependency type and version fields. +It will try to download from foswiki.org to satisfy any missing dependencies. +Downloaded modules are automatically installed. + +Note that the dependencies will only work if the module depended on follows +the naming standards for zips i.e. it must be attached to the topic in +foswiki.org and have the same name as the topic, and must be a zip file. + +Dependencies on CPAN modules are also checked (type perl) but no attempt +is made to install them. + +The install script also acts as an uninstaller and upgrade script. + +__Note__ that =target_install= builds and invokes this install script. + +At present there is no support for a caller-provided post-install script, but +this would be straightforward to do if it were required. + +=cut + +sub target_installer { + my $this = shift; + + return + if defined $this->{options}->{installers} + && $this->{options}->{installers} =~ /none/; + + # Add the install script to the manifest, unless it is already there + unless ( + grep( /^$this->{project}_installer$/, + map { $_->{name} } @{ $this->{files} } ) + ) + { + push( + @{ $this->{files} }, + { + name => $this->{project} . '_installer', + description => 'Install script', + permissions => 0770 + } + ); + warn 'Auto-adding install script to manifest', "\n" + if ( $this->{-v} ); + } + + # Find the template on @INC + my $template; + foreach my $d (@INC) { + my $dir = `dirname $d`; + chop($dir); + my $file = + $dir . '/lib/Foswiki/Contrib/BuildContrib/TEMPLATE_installer.pl'; + if ( -f $file ) { + $template = $file; + last; + } + $dir .= '/contrib'; + if ( -f $dir . '/TEMPLATE_installer.pl' ) { + $template = $dir . '/TEMPLATE_installer.pl'; + last; + } + } + unless ($template) { + die +'COULD NOT LOCATE TEMPLATE_installer.pl - required for install script generation'; + } + + my @sats; + foreach my $dep ( @{ $this->{dependencies} } ) { + my $descr = $dep->{description}; + $descr =~ s/"/\\\"/g; + $descr =~ s/\$/\\\$/g; + $descr =~ s/\@/\\\@/g; + $descr =~ s/\%/\\\%/g; + my $trig = $dep->{trigger}; + $trig = 1 unless ($trig); + push( @sats, +"{ name=>'$dep->{name}', type=>'$dep->{type}',version=>'$dep->{version}',description=>'$descr', trigger=>$trig }" + ); + } + my $satisfies = join( ",", @sats ); + $this->{SATISFIES} = $satisfies; + + my $installScript = + $this->{basedir} . '/' . $this->{project} . '_installer'; + if ( $this->{-v} || $this->{-n} ) { + print 'Generating installer in ', $installScript, "\n"; + } + + $this->filter_txt( $template, $installScript ); + + # Copy it to .pl + $this->cp( $installScript, "$installScript.pl" ); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/manifest.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/manifest.pm new file mode 100644 index 0000000000..341629682d --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/manifest.pm @@ -0,0 +1,88 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +my $collector; + +=begin TML + +---++++ target_manifest +Generate and print to STDOUT a rough guess at the MANIFEST listing + +=cut + +sub target_manifest { + my $this = shift; + + $collector = $this; + my $manifest = findRelative( $buildpldir, 'MANIFEST' ); + if ( $manifest && -e $manifest ) { + open( F, '<', $manifest ) + || die 'Could not open existing ' . $manifest; + local $/ = undef; + %{ $collector->{manilist} } = + map { /^(.*?)(\s+.*)?$/; $1 => ( $2 || '' ) } split( /\r?\n/, ); + close(F); + } + else { + $manifest = $buildpldir . '/MANIFEST'; + } + require File::Find; + $collector->{manilist} = (); + warn "Gathering from $this->{basedir}\n"; + + File::Find::find( \&_manicollect, $this->{basedir} ); + print '# DRAFT ', $manifest, ' follows:', "\n"; + print '################################################', "\n"; + for ( sort keys %{ $collector->{manilist} } ) { + print $_. ' ' . $collector->{manilist}{$_} . "\n"; + } + print '################################################', "\n"; + print '# Copy and paste the text between the ###### lines into the file', + "\n"; + print '# ' . $manifest, "\n"; + print '# to create an initial manifest. Remove any files', "\n"; + print '# that should _not_ be released, and add a', "\n"; + print '# description of each file at the end of each line.', "\n"; +} + +sub _manicollect { + if (/^(CVS|\.svn|\.git)$/) { + $File::Find::prune = 1; + } + elsif ( + !-d + && /^\w.*\w$/ + && !/^(DEPENDENCIES|MANIFEST|(PRE|POST)INSTALL|build\.pl)$/ + && !/\.bak$/ + && !/^$collector->{project}_installer(\.pl)?$/ + + # Item10188: Ignore build output, but still want data/System/Project.txt + # $basedir in \Q...\E makes it a literal string (ignore regex chars) + && not $File::Find::name =~ + /\Q$basedir\E\W$collector->{project}\.(md5|zip|tgz|txt|sha1)$/ + ) + { + my $n = $File::Find::name; + my @a = stat($n); + my $perms = sprintf( "%04o", $a[2] & 0777 ); + $n =~ s/$collector->{basedir}\/?//; + $collector->{manilist}{$n} = $perms + unless exists $collector->{manilist}{$n}; + } +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/release.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/release.pm new file mode 100644 index 0000000000..99cbc438fb --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/release.pm @@ -0,0 +1,47 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +=begin TML + +---++++ target_release +Release target, builds release zip by creating a full release directory +structure in /tmp and then zipping it in one go. Only files explicitly listed +in the MANIFEST are released. Automatically runs =filter= on all =.txt= files +in the MANIFEST. + +=cut + +sub target_release { + my $this = shift; + + print <{RELEASE} of $this->{project}, from version $this->{VERSION} +GUNK + if ( $this->{-v} ) { + print 'Package name will be ', $this->{project}, "\n"; + print 'Topic name will be ', $this->getTopicName(), "\n"; + } + + $this->build('compress'); + $this->build('build'); + $this->build('installer'); + $this->build('stage'); + $this->build('archive'); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/stage.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/stage.pm new file mode 100644 index 0000000000..ade1c0f988 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/stage.pm @@ -0,0 +1,77 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +my @stageFilters = ( + { RE => qr/\.txt$/, filter => 'filter_txt' }, + { RE => qr/\.pm$/, filter => 'filter_pm' }, +); + +=begin TML + +---++++ target_stage +stages all the files to be in the release in a tmpDir, ready for target_archive + +=cut + +sub target_stage { + my $this = shift; + my $project = $this->{project}; + + $this->{tmpDir} ||= File::Temp::tempdir( CLEANUP => 1 ); + File::Path::mkpath( $this->{tmpDir} ); + + $this->copy_fileset( $this->{files}, $this->{basedir}, $this->{tmpDir} ); + + foreach my $file ( @{ $this->{files} } ) { + foreach my $filter (@stageFilters) { + if ( $file->{name} =~ /$filter->{RE}/ ) { + my $fn = $filter->{filter}; + $this->$fn( + $this->{basedir} . '/' . $file->{name}, + $this->{tmpDir} . '/' . $file->{name} + ); + } + } + } + if ( -e $this->{tmpDir} . '/' . $this->{topic_root} . '.txt' ) { + $this->cp( + $this->{tmpDir} . '/' . $this->{topic_root} . '.txt', + $this->{basedir} . '/' . $project . '.txt' + ); + } + $this->apply_perms( $this->{files}, $this->{tmpDir} ); + + if ( $this->{other_modules} ) { + my $libs = join( ':', @INC ); + foreach my $module ( @{ $this->{other_modules} } ) { + + die "$basedir / $module does not exist, cannot build $module\n" + unless ( -e "$basedir/$module" ); + + warn "Installing $module in $this->{tmpDir}\n"; + + #SMELL: uses legacy TWIKI_ exports + my $cmd = +"export FOSWIKI_HOME=$this->{tmpDir}; export FOSWIKI_LIBS=$libs; export TWIKI_HOME=$this->{tmpDir}; export TWIKI_LIBS=$libs; cd $basedir/$module; perl build.pl handsoff_install"; + + #warn "***** running $cmd \n"; + print `$cmd`; + } + } +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/test.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/test.pm new file mode 100644 index 0000000000..e0ea1fc649 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/test.pm @@ -0,0 +1,63 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +=begin TML + +---++++ target_test +Basic CPAN:Test::Unit test target, runs <project>Suite. + +=cut + +sub target_test { + my $this = shift; + $this->build('build'); + + # find testrunner + my $testrunner = $this->findRelative('core/test/bin/TestRunner.pl') + || $this->findRelative('test/bin/TestRunner.pl'); + + my $tests = $this->findRelative( + 'test/unit/' . $this->{project} . '/' . $this->{project} . 'Suite.pm' ); + unless ($tests) { + $tests = $this->findRelative( + '/core/test/unit/' . $this->{project} . 'Suite.pm' ) + || $this->findRelative( + '/test/unit/' . $this->{project} . 'Suite.pm' ); + unless ($tests) { + warn 'WARNING: COULD NOT FIND ANY UNIT TESTS FOR ' + . $this->{project}; + return; + } + } + unless ($testrunner) { + warn <pushd($testdir); + $this->{-v} = 1; # to get the command printed + $this->sys_action( 'perl', '-w', @inc, $testrunner, $tests ); + $this->popd(); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/tidy.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/tidy.pm new file mode 100644 index 0000000000..459caa85d0 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/tidy.pm @@ -0,0 +1,68 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +my @tidyFilters = ( { RE => qr/\.pl$/ }, { RE => qr/\.pm$/ }, ); +my $collector; + +=begin TML + +---++++ target_tidy +Reformat .pm and .pl files using perltidy default options + +=cut + +sub target_tidy { + my $this = shift; + require Perl::Tidy; # Will throw exception if not available + + # Can't use the MANIFEST list, otherwise we miss tests etc, so apply + # to all files found under lib. + require File::Find; + my @files = (); + $collector = \@files; + File::Find::find( \&_isPerl, "$this->{basedir}" ); + + foreach my $path (@files) { + print "Tidying $path\n"; + local @ARGV = ($path); + Perl::Tidy::perltidy(); + File::Copy::move( "$path.tdy", $path ); + } +} + +sub _isPerl { + if ( $File::Find::name =~ /(CVS|\.svn|\.git|~)$/ ) { + $File::Find::prune = 1; + } + elsif ( !-d $File::Find::name ) { + if ( $File::Find::name =~ /\.p[lm]$/ ) { + push( @$collector, $File::Find::name ); + } + elsif ( $File::Find::name !~ m#\.[^/]+$# + && open( F, '<', $File::Find::name ) ) + { + local $/ = "\n"; + my $shebang = ; + close(F); + if ( $shebang && $shebang =~ /^#!.*perl/ ) { + push( @$collector, $File::Find::name ); + } + } + } +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/tracked.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/tracked.pm new file mode 100644 index 0000000000..fe7ef0fbdd --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/tracked.pm @@ -0,0 +1,82 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +sub _filter_tracked_pm { + my ( $this, $from, $to ) = @_; + $this->filter_file( + $from, $to, + sub { + my ( $this, $text ) = @_; + $text =~ s/%\$RELEASE%/$this->{RELEASE}/gm; + $text =~ s/%\$TRACKINGCODE%/$this->{TRACKINGCODE}/gm; + return $text; + } + ); +} + +sub target_tracked { + my $this = shift; + local $/ = "\n"; + my %customers; + my @cuss; + my $db = prompt( "Location of customer database", $DEFAULTCUSTOMERDB ); + if ( open( F, '<', $db ) ) { + while ( my $customer = ) { + chomp($customer); + if ( $customer =~ /^(.+)\s(\S+)\s*$/ ) { + $customers{$1} = $2; + } + } + close(F); + @cuss = sort keys %customers; + my $i = 0; + print join( "\n", map { $i++; "$i. $_" } @cuss ) . "\n"; + } + else { + print "$db not found: $@\n"; + print "Creating new customer DB\n"; + } + + my $customer = prompt("Number (or name) of customer"); + if ( $customer =~ /^\d+$/i && $customer <= scalar(@cuss) ) { + $customer = $cuss[ $customer - 1 ]; + } + + if ( $customers{$customer} ) { + $this->{TRACKINGCODE} = $customers{$customer}; + } + else { + print "Customer '$customer' not known\n"; + exit 0 unless ask("Would you like to add a new customer?"); + + $this->{TRACKINGCODE} = Digest::MD5::md5_base64( $customer . $db ); + $customers{$customer} = $this->{TRACKINGCODE}; + + open( F, '>', $db ) || die $!; + print F join( "\n", map { "$_ $customers{$_}" } keys %customers ) + . "\n"; + close(F); + } + + warn "$customer tracking code $customers{$customer}\n"; + + push( @stageFilters, { RE => qr/\.pm$/, filter => '_filter_tracked_pm' } ); + + $this->build('release'); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/twiki.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/twiki.pm new file mode 100644 index 0000000000..2d60f901c3 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/twiki.pm @@ -0,0 +1,139 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +our @twikiFilters = ( + { RE => qr/\.pm$/, filter => '_twikify_perl' }, + { RE => qr/\.pm$/, filter => '_twikify_txt' }, + { RE => qr#/Config.spec$#, filter => '_twikify_perl' }, + { RE => qr#/MANIFEST$#, filter => '_twikify_manifest' }, + { RE => qr#/DEPENDENCIES$#, filter => '_twikify_perl' }, +); + +# Create a TWiki version of the extension by simple transformation of files. +# Useless for processing CSS, JS or anything else complex. +sub target_twiki { + my $this = shift; + + print STDERR <{basedir}/##; + push( @{ $this->{files} }, { name => "$r/MANIFEST" } ); + push( @{ $this->{files} }, { name => "$r/DEPENDENCIES" } ); + push( @{ $this->{files} }, { name => "$r/build.pl" } ); + + foreach my $file ( @{ $this->{files} } ) { + my $nf = $file->{name}; + if ( $file->{name} =~ m#^(data|pub)/System/(.*)$# ) { + $nf = "$1/TWiki/$2"; + } + elsif ( $file->{name} =~ m#^lib/Foswiki/(.*)$# ) { + $nf = "lib/TWiki/$1"; + } + if ( $nf ne $file->{name} ) { + my $filtered = 0; + foreach my $filter (@twikiFilters) { + if ( $file->{name} =~ /$filter->{RE}/ ) { + my $fn = $filter->{filter}; + $this->$fn( $this->{basedir} . '/' . $file->{name}, + $this->{basedir} . '/' . $nf ); + $filtered = 1; + last; + } + } + unless ($filtered) { + $this->cp( $this->{basedir} . '/' . $file->{name}, + $this->{basedir} . '/' . $nf ); + } + $file->{name} = $nf; + print "Created $file->{name}\n"; + } + } +} + +sub _twikify_perl { + my ( $this, $from, $to ) = @_; + + $this->filter_file( + $from, $to, + sub { + my ( $this, $text ) = @_; + $text =~ s/Foswiki::/TWiki::/g; + $text =~ s/new Foswiki\s*\(\s*\);/new TWiki();/g; + $text =~ s/\b(use|require)\s+Foswiki/$1 TWiki/g; + $text =~ s/foswiki\([A-Z][A-Za-z]\+\)/twiki$1/g; + $text =~ s/'foswiki'/'twiki'/g; + $text =~ s/FOSWIKI_/TWIKI_/g; + $text =~ s/foswikiNewLink/twikiNewLink/g; # CSS + $text =~ s/foswikiAlert/twikiAlert/g; + $text =~ s/new Foswiki/new TWiki/g; + return <<'CAVEAT' . $text; +# This TWiki version was auto-generated from Foswiki sources by BuildContrib. +# Copyright (C) 2008-2010 Foswiki Contributors + +CAVEAT + + # Note: the last blank line is to avoid mangling =pod + } + ); +} + +sub _twikify_manifest { + my ( $this, $from, $to ) = @_; + + $this->filter_file( + $from, $to, + sub { + my ( $this, $text ) = @_; + $text =~ s#^data/System#data/TWiki#gm; + $text =~ s#^pub/System#pub/TWiki#gm; + $text =~ s#^lib/Foswiki#lib/TWiki#gm; + return <filter_file( + $from, $to, + sub { + my ( $this, $text ) = @_; + return < +This TWiki version was auto-generated from Foswiki sources by BuildContrib. +
+Copyright (C) 2008-2010 Foswiki Contributors + +$text +HERE + } + ); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/uninstall.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/uninstall.pm new file mode 100644 index 0000000000..ed0f7fed28 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/uninstall.pm @@ -0,0 +1,36 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +=begin TML + +---++++ target_uninstall +Uninstall target, uninstall from local twiki pointed at by FOSWIKI_HOME. + +Uses the installer script written by target_installer + +=cut + +sub target_uninstall { + my $this = shift; + my $home = $ENV{FOSWIKI_HOME}; + die 'FOSWIKI_HOME not set' unless $home; + $this->pushd($home); + $this->sys_action( 'perl', $this->{project} . '_installer', 'uninstall' ); + $this->popd(); +} + +1; diff --git a/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/upload.pm b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/upload.pm new file mode 100644 index 0000000000..b2572113e1 --- /dev/null +++ b/BuildContrib/lib/Foswiki/Contrib/BuildContrib/Targets/upload.pm @@ -0,0 +1,499 @@ +# +# Copyright (C) 2004-2012 C-Dot Consultants - All rights reserved +# Copyright (C) 2008-2010 Foswiki Contributors +# +# 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, published at +# http://www.gnu.org/copyleft/gpl.html +# +package Foswiki::Contrib::Build; + +use LWP; +use LWP::UserAgent; + +# number of seconds to sleep between uploads, +# to reduce average load on server +use constant GLACIERMELT => 10; + +my $lastUpload = 0; # time of last upload (0 means none yet) + +{ + + package Foswiki::Contrib::Build::UserAgent; + our @ISA = qw( LWP::UserAgent ); + + sub new { + my ( $class, $id, $bldr ) = @_; + my $this = $class->SUPER::new( + keep_alive => 1, + + # Item721: Get proxy settings from environment variables + env_proxy => 1 + ); + $this->{domain} = $id; + $this->{builder} = $bldr; + require HTTP::Cookies; + $this->cookie_jar( + new HTTP::Cookies( + file => "$ENV{HOME}/.lwpcookies", + autosave => 1, + ignore_discard => 1 + ) + ); + + return $this; + } + + sub get_basic_credentials { + my ( $this, $realm, $uri ) = @_; + return $this->{builder}->getCredentials( $uri->host() ); + } +} + +=begin TML + +---++++ target_upload +Upload to a repository. Prompts for username and password. Uploads the zip and +the text topic to the appropriate places. Creates the topic if +necessary. + +=cut + +sub target_upload { + my $this = shift; + + my $to = $this->{project}; + + while (1) { + print <{UPLOADTARGETWEB} +PubDir: $this->{UPLOADTARGETPUB} +Scripts: $this->{UPLOADTARGETSCRIPT} +Suffix: $this->{UPLOADTARGETSUFFIX} + +If upload target does not exist, recover package form from: +Web: $this->{DOWNTARGETWEB} +Scripts: $this->{DOWNTARGETSCRIPT} +Suffix: $this->{DOWNTARGETSUFFIX} +END + + last if ask( "Is that correct? Answer 'n' to change", 1 ); + print "Enter the name of the web that contains the target repository\n"; + $this->{UPLOADTARGETWEB} = prompt( "Web", $this->{UPLOADTARGETWEB} ); + print "Enter the full URL path to the pub directory\n"; + $this->{UPLOADTARGETPUB} = prompt( "PubDir", $this->{UPLOADTARGETPUB} ); + print "Enter the full URL path to the bin directory\n"; + $this->{UPLOADTARGETSCRIPT} = + prompt( "Scripts", $this->{UPLOADTARGETSCRIPT} ); + print +"Enter the file suffix used on scripts in the bin directory (enter 'none' for none)\n"; + $this->{UPLOADTARGETSUFFIX} = + prompt( "Suffix", $this->{UPLOADTARGETSUFFIX} ); + $this->{UPLOADTARGETSUFFIX} = '' + if $this->{UPLOADTARGETSUFFIX} eq 'none'; + print +"\nEnter the alternate name of the web that contains the package form\n"; + $this->{DOWNTARGETWEB} = prompt( "Web", $this->{DOWNTARGETWEB} ); + + print "Enter the full URL path to the alternate bin directory\n"; + $this->{DOWNTARGETSCRIPT} = + prompt( "Scripts", $this->{DOWNTARGETSCRIPT} ); + print +"Enter the file suffix used on scripts in the alternate bin directory (enter 'none' for none)\n"; + $this->{DOWNTARGETSUFFIX} = + prompt( "Suffix", $this->{DOWNTARGETSUFFIX} ); + $this->{DOWNTARGETSUFFIX} = '' + if $this->{DOWNTARGETSUFFIX} eq 'none'; + + my $rep = $this->{config}->{repositories}->{ $this->{project} } || {}; + $rep->{pub} = $this->{UPLOADTARGETPUB}; + $rep->{script} = $this->{UPLOADTARGETSCRIPT}; + $rep->{suffix} = $this->{UPLOADTARGETSUFFIX}; + $rep->{web} = $this->{UPLOADTARGETWEB}; + $rep->{downscript} = $this->{DOWNTARGETSCRIPT}; + $rep->{downsuffix} = $this->{DOWNTARGETSUFFIX}; + $rep->{downweb} = $this->{DOWNTARGETWEB}; + $this->{config}->{repositories}->{ $this->{project} } = $rep; + $this->saveConfig(); + } + + my $userAgent = + new Foswiki::Contrib::Build::UserAgent( $this->{UPLOADTARGETSCRIPT}, + $this ); + $userAgent->agent( 'ContribBuild/' . $VERSION . ' ' ); + $userAgent->cookie_jar( {} ); + $userAgent->timeout(420); + + my $topic = $this->getTopicName(); + + # Ask for username and password + my ( $user, $pass ) = $this->_getCredentials( $this->{UPLOADTARGETSCRIPT} ); + + # Ask what the user wants to upload + my $doUploadArchivesAndInstallers = + ask( "Do you want to upload the archives and installers?", 1 ); + + #need the topic at this point. + $this->build('release'); + my $topicText; + my $baseTopic = $this->{basedir} . '/' . $to . '.txt'; + local $/ = undef; # set to read to EOF + if ( open( IN_FILE, '<', $baseTopic ) ) { + print "Basing new topic on " . $baseTopic . "\n"; + $topicText = ; + close(IN_FILE); + } + else { + warn 'Failed to open base topic(' . $baseTopic . '): ' . $!; + $topicText = <_login( $userAgent, $user, $pass ); + + my $url = +"$this->{UPLOADTARGETSCRIPT}/view$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$topic"; + my $alturl = +"$this->{DOWNTARGETSCRIPT}/view$this->{DOWNTARGETSUFFIX}/$this->{DOWNTARGETWEB}/$topic"; + + # Get the old form data and attach it to the update + print "Downloading $topic to recover form\n"; + my $response = $userAgent->get("$url?raw=all"); + + my %newform; + my $formExists = 0; + + # SMELL: There appears to be no way to distinguish if Foswiki didn't + # find the topic and returns the topic creator form, or if the GET + # was successful. Foswiki always returns 200 for the status + # We need a better way of handling the not-found condition. + # For now, look to see if there is a newtopicform present. If found, + # it means that the get should be treated as a NOT FOUND. + + unless ( $response->is_success() + && !( $response->content() =~ m/is_success ) { + print 'Failed to GET old topic ', $response->request->uri, + ' -- ', $response->status_line, "\n"; + } + + if ( ( $this->{DOWNTARGETSCRIPT} ne $this->{UPLOADTARGETSCRIPT} ) + || ( $this->{DOWNTARGETWEB} ne $this->{UPLOADTARGETWEB} ) ) + { + print "Downloading $topic from $alturl to recover form\n"; + $response = $userAgent->get("$alturl?raw=all"); + unless ( $response->is_success ) { + print 'Failed to GET old topic from Alternate location', + $response->request->uri, + $newform{formtemplate} = 'PackageForm'; + if ( $this->{project} =~ /(Plugin|Skin|Contrib|AddOn)$/ ) { + $newform{TopicClassification} = $1 . 'Package'; + } + } + } + } + if ( $response->is_success() + && !( $response->content() =~ m/content() ) ) { + + if ( $line =~ m/%META:FIELD{name="(.*?)".*?value="(.*?)"/ ) { + my $name = $1; + my $val = $2; + + # URL-decode the value + $val =~ s/%([\da-f]{2})/chr(hex($1))/gei; + + # Trim null values or we end up damaging the form + if ( defined $val && length($val) ) { + $newform{$name} = $val; + } + } + elsif ( $line =~ /META:FORM{name="PackageForm/ ) { + $newform{formtemplate} = 'PackageForm'; + $formExists = 1; + } + } + + if ( !$formExists ) { + $newform{formtemplate} ||= 'PackageForm'; + } + if ( $this->{project} =~ /(Plugin|Skin|Contrib|AddOn)$/ ) { + $newform{TopicClassification} ||= $1 . 'Package'; + } + } + + $newform{text} = $topicText; + + $this->_uploadTopic( $userAgent, $user, $pass, $topic, \%newform ); + + # Upload any 'Var*.txt' topics published by the extension + my $dataDir = $this->{basedir} . '/data/System'; + if ( opendir( DIR, $dataDir ) ) { + foreach my $f ( grep( /^Var\w+\.txt$/, readdir DIR ) ) { + if ( open( IN_FILE, '<', $this->{basedir} . '/data/System/' . $f ) ) + { + %newform = ( text => ); + close(IN_FILE); + $f =~ s/\.txt$//; + $this->_uploadTopic( $userAgent, $user, $pass, $f, \%newform ); + } + } + } + + return if ( $this->{-topiconly} ); + + # upload any attachments to the developer's version of the topic. Any other + # attachments to the topic on t.o. will still be there. + my %uploaded; # flag already uploaded + + if ($doUploadAttachments) { + foreach my $a (@attachments) { + $a =~ /name="([^"]*)"/; + my $name = $1; + next if $uploaded{$name}; + next if $name =~ /^$to(\.zip|\.tgz|_installer|\.md5|\.sha1)$/; + $a =~ /comment="([^"]*)"/; + my $comment = $1; + $a =~ /attr="([^"]*)"/; + my $attrs = $1 || ''; + + $this->_uploadAttachment( + $userAgent, + $user, + $pass, + $name, + $this->{basedir} + . '/pub/System/' + . $this->{project} . '/' + . $name, + $comment, + $attrs =~ /h/ ? 1 : 0 + ); + $uploaded{$name} = 1; + } + } + + return unless $doUploadArchivesAndInstallers; + + # Upload the standard files + foreach my $ext (qw(.zip .tgz _installer .md5 .sha1)) { + my $name = $to . $ext; + next if $uploaded{$name}; + $this->_uploadAttachment( $userAgent, $user, $pass, $to . $ext, + $this->{basedir} . '/' . $to . $ext, '' ); + $uploaded{$name} = 1; + } +} + +sub _login { + my ( $this, $userAgent, $user, $pass ) = @_; + + #Send a login request - to get a validation key for strikeone + my $response = $userAgent->get( + "$this->{UPLOADTARGETSCRIPT}/login$this->{UPLOADTARGETSUFFIX}"); + + # "(Foswiki login)" or "Login - Foswiki" + unless ( ( $response->code == 200 || $response->code == 400 ) + and $response->header('title') =~ /login/i ) + { + die 'Failed to GET login form ' + . $response->request->uri . ' -- ' + . $response->status_line . "\n"; + } + + my $validationKey = $this->_strikeone( $userAgent, $response ); + + $response = $userAgent->post( + "$this->{UPLOADTARGETSCRIPT}/login$this->{UPLOADTARGETSUFFIX}", + { + username => $user, + password => $pass, + validation_key => $validationKey + } + ); + + die 'Login failed ' + . $response->request->uri . ' -- ' + . $response->status_line . "\n" + . 'Aborting' . "\n" + unless $response->is_redirect + && $response->headers->header('Location') !~ m{/oops}; +} + +sub _uploadTopic { + my ( $this, $userAgent, $user, $pass, $topic, $form ) = @_; + + # send an edit request to get a validation key + my $response = $userAgent->get( +"$this->{UPLOADTARGETSCRIPT}/edit$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$topic" + ); + unless ( $response->is_success ) { + die 'Request to edit ' + . $this->{UPLOADTARGETWEB} . '/' + . $topic + . ' failed ' + . $response->request->uri . ' -- ' + . $response->status_line . "\n"; + } + + $form->{validation_key} = $this->_strikeone( $userAgent, $response ); + + $form->{text} =~ s/^%META:TOPICINFO{.*?\n//; # Delete any old topicinfo + my $url = +"$this->{UPLOADTARGETSCRIPT}/save$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$topic"; + $form->{text} = <{text}; + +EXTRA + print "Saving $topic\n"; + $this->_postForm( $userAgent, $user, $pass, $url, $form ); +} + +sub _uploadAttachment { + my ( $this, $userAgent, $user, $pass, $filename, $filepath, $filecomment, + $hide ) + = @_; + + # send an edit request to get a validation key + my $response = $userAgent->get( +"$this->{UPLOADTARGETSCRIPT}/edit$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$this->{project}" + ); + unless ( $response->is_success ) { + die 'Request to edit ' + . $this->{UPLOADTARGETWEB} . '/' + . $this->{project} + . ' failed ' + . $response->request->uri . ' -- ' + . $response->status_line . "\n"; + } + + my $url = +"$this->{UPLOADTARGETSCRIPT}/upload$this->{UPLOADTARGETSUFFIX}/$this->{UPLOADTARGETWEB}/$this->{project}"; + my $form = [ + 'filename' => $filename, + 'filepath' => [$filepath], + 'filecomment' => $filecomment, + 'hidefile' => $hide || 0, + 'validation_key' => $this->_strikeone( $userAgent, $response ), + ]; + + print "Uploading $this->{UPLOADTARGETWEB}/$this->{project}/$filename\n"; + $this->_postForm( $userAgent, $user, $pass, $url, $form ); +} + +sub _strikeone { + my ( $this, $userAgent, $response ) = @_; + + my $f = $response->content(); + $f =~ s/<\/form>.*//sm; + $f =~ s/.*//sm; + my $validationKey; + while ( $f =~ /]*)>/g ) { + my $attrs = $1; + if ( $attrs =~ /\bname=["']validation_key["']/ + and $attrs =~ /\bvalue=["'](.*?)["']/ ) + { + $validationKey = $1; + last; + } + } + if ( not defined $validationKey ) { + warn "WARNING: The form does not have a validation_key field\n"; + return ''; + } + + my $cookie; + $userAgent->cookie_jar()->scan( + sub { + my ( $version, $key, $value ) = @_; + $cookie = $value if $key eq 'FOSWIKISTRIKEONE'; + } + ); + if ( not defined $cookie ) { + warn +"WARNING: Could not find strikeone cookie in cookiejar - disabling strikeone\n"; + return $validationKey; + } + + $validationKey =~ s/^\?//; + + return Digest::MD5::md5_hex( $validationKey . $cookie ); +} + +sub _postForm { + my ( $this, $userAgent, $user, $pass, $url, $form ) = @_; + + my $pause = GLACIERMELT - ( time - $lastUpload ); + if ( $pause > 0 ) { + print "Taking a ${pause}s breather after the last upload...\n"; + sleep($pause); + } + $lastUpload = time(); + + my $response = + $userAgent->post( $url, $form, 'Content_Type' => 'form-data' ); + + die 'Upload failed ', $response->request->uri, + ' -- ', $response->status_line, "\n", 'Aborting', "\n", + $response->as_string + unless $response->is_redirect + && $response->headers->header('Location') !~ m{/oops|/log.n/}; +} + +sub _getCredentials { + my ( $this, $host ) = @_; + my $config = $this->_loadConfig(); + my $pws = $config->{passwords}->{$host}; + if ($pws) { + print "Using credentials for $host saved in $config->{file}\n"; + } + else { + local $/ = "\n"; + print 'Enter username for ', $host, ': '; + my $knownUser = ; + chomp($knownUser); + die "Inadequate user" unless length $knownUser; + print 'Password: '; + system('stty -echo'); + my $knownPass = ; + system('stty echo'); + print "\n"; # because we disabled echo + chomp($knownPass); + $pws = { user => $knownUser, pass => $knownPass }; + $config->{passwords}->{$host} = $pws; + $this->saveConfig(); + } + return ( $pws->{user}, $pws->{pass} ); +} + +1; diff --git a/UnitTestContrib/test/unit/ConfigureTests.pm b/UnitTestContrib/test/unit/ConfigureTests.pm index a49e45be25..acd1d53fc8 100644 --- a/UnitTestContrib/test/unit/ConfigureTests.pm +++ b/UnitTestContrib/test/unit/ConfigureTests.pm @@ -1155,18 +1155,6 @@ our $VERSION = '2.1'; __DATA__ <<<< MANIFEST >>>> -bin/shbtest1,0755, -data/Sandbox/TestTopic1.txt,0644,Documentation (noci) -data/Sandbox/TestTopic43.txt,0644,Documentation -data/Sandbox/Subweb/TestTopic43.txt,0644,Documentation -pub/Sandbox/TestTopic1/file.att,0664, (noci) -pub/Sandbox/TestTopic43/file.att,0664, -pub/Sandbox/TestTopic43/file2.att,0664, -pub/Sandbox/Subweb/TestTopic43/file3.att,0644,Documentation -pub/Sandbox/Subweb/TestTopic43/subdir-1.2.3/file4.att,0644,Documentation -tools/shbtest2,0755, - -<<<< MANIFEST2 >>>> bin/shbtest1,0755,1a9a1da563535b2dad241d8571acd170, data/Sandbox/TestTopic1.txt,0644,1a9a1da563535b2dad241d8571acd170,Documentation (noci) data/Sandbox/TestTopic43.txt,0644,4dcabc1c8044e816f3c3d1a071ba1bc5,Documentation diff --git a/core/lib/Foswiki/Configure/Package.pm b/core/lib/Foswiki/Configure/Package.pm index cd0035e2c8..555ee8efdb 100644 --- a/core/lib/Foswiki/Configure/Package.pm +++ b/core/lib/Foswiki/Configure/Package.pm @@ -1292,18 +1292,18 @@ sub Manifest { foreach my $file ( sort keys( %{ $this->{_manifest} } ) ) { next if ( $file eq 'ATTACH' ); - $rslt .= -"$file $this->{_manifest}->{$file}->{perms} $this->{_manifest}->{$file}->{md5} $this->{_manifest}->{$file}->{desc}\n"; + $rslt .= join( " ", + $file, + map { $this->{_manifest}->{$file}->{$_} } qw( perms md5 desc ) ) + . "\n"; } return $rslt; } =begin TML ----++ _parseManifest ( $line, $v2) -Parse the manifest line into the manifest hash. If $v2 is -true, use the version 2 format containing the MD5 sum of -the file. +---++ _parseManifest ( $line ) +Parse the manifest line into the manifest hash. ->{filename}->{ci} Flag if file should be "checked in" ->{filename}->{perms} File permissions @@ -1314,19 +1314,16 @@ the file. sub _parseManifest { my $this = shift; - my $file = ''; - my $perms = ''; - my $md5 = ''; - my $desc = ''; + my ( $file, $perms, $md5, $desc ) = # New format + $line =~ /^(".+"|\S+)\s+(\d+)(?:\s+([a-f0-9]{32}))?\s+(.*)$/; - if ( $_[1] ) { - ( $file, $perms, $md5, $desc ) = split( ',', $_[0], 4 ); - } - else { - ( $file, $perms, $desc ) = split( ',', $_[0], 3 ); + unless ($file) { # Old format, for legacy + ( $file, $perms, $md5, $desc ) = + /^([^,]+)(?:,([^,]+)(?:,([a-f0-9]{32}))?,(.*))?$/; } - return "No file found in $_[1] - line bypassed" unless ($file); + return "No file found in $line - line bypassed" unless $file; + $file =~ s/^"(.+)"$/$1/; my $tweb = ''; my $ttopic = '';