r71358 - in /branches/upstream/libmojomojo-perl/current: ./ inc/File/ inc/File/Copy/ inc/Module/Install/ lib/ lib/MojoMojo/Controller/ lib/MojoMojo/Formatter/ t/ t/c/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sun Mar 13 21:16:45 UTC 2011
Author: jawnsy-guest
Date: Sun Mar 13 21:14:53 2011
New Revision: 71358
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71358
Log:
[svn-upgrade] new version libmojomojo-perl (1.04+dfsg)
Added:
branches/upstream/libmojomojo-perl/current/inc/File/
branches/upstream/libmojomojo-perl/current/inc/File/Copy/
branches/upstream/libmojomojo-perl/current/inc/File/Copy/Recursive.pm
branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Gist.pm
branches/upstream/libmojomojo-perl/current/t/formatter_gist.t
Modified:
branches/upstream/libmojomojo-perl/current/Changes
branches/upstream/libmojomojo-perl/current/MANIFEST
branches/upstream/libmojomojo-perl/current/META.yml
branches/upstream/libmojomojo-perl/current/inc/Module/Install/Catalyst.pm
branches/upstream/libmojomojo-perl/current/lib/MojoMojo.pm
branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Controller/PageAdmin.pm
branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Amazon.pm
branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/GoogleCalendar.pm
branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/IDLink.pm
branches/upstream/libmojomojo-perl/current/t/c/page_edit.t
branches/upstream/libmojomojo-perl/current/t/formatter_amazon.t
Modified: branches/upstream/libmojomojo-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/Changes?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/Changes (original)
+++ branches/upstream/libmojomojo-perl/current/Changes Sun Mar 13 21:14:53 2011
@@ -1,3 +1,15 @@
+1.04 2011-02-12 10:24
+ Improvements:
+ - Don't save a page when there is no change even if we push the save button.
+ This prevents the revision number from being incremented.
+ - Added gist formatter (bayashi)
+
+ Fixes:
+ - Amazon requires a secret key now to access it's API.
+ Make the Amazon formatter aware of that.
+ - Google calendar formatter was setting precomple_off = 1 always
+ (even when it wasn't a calendar page).
+
1.03 2011-01-12 11:36
New features:
- Google Calendar formatter
Modified: branches/upstream/libmojomojo-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/MANIFEST?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/MANIFEST (original)
+++ branches/upstream/libmojomojo-perl/current/MANIFEST Sun Mar 13 21:14:53 2011
@@ -1,4 +1,5 @@
Changes
+inc/File/Copy/Recursive.pm
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AutoInstall.pm
@@ -45,6 +46,7 @@
lib/MojoMojo/Formatter/File/Image.pm
lib/MojoMojo/Formatter/File/Pod.pm
lib/MojoMojo/Formatter/File/Text.pm
+lib/MojoMojo/Formatter/Gist.pm
lib/MojoMojo/Formatter/GoogleCalendar.pm
lib/MojoMojo/Formatter/GoogleSearch.pm
lib/MojoMojo/Formatter/IDLink.pm
@@ -478,6 +480,7 @@
t/formatter_dir.t
t/formatter_docbook.t
t/formatter_file.t
+t/formatter_gist.t
t/formatter_googlesearch.t
t/formatter_idlink.t
t/formatter_include.t
Modified: branches/upstream/libmojomojo-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/META.yml?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/META.yml (original)
+++ branches/upstream/libmojomojo-perl/current/META.yml Sun Mar 13 21:14:53 2011
@@ -107,4 +107,4 @@
homepage: http://mojomojo.org
license: http://dev.perl.org/licenses/
repository: http://github.com/marcusramberg/mojomojo/
-version: 1.03
+version: 1.04
Added: branches/upstream/libmojomojo-perl/current/inc/File/Copy/Recursive.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/inc/File/Copy/Recursive.pm?rev=71358&op=file
==============================================================================
--- branches/upstream/libmojomojo-perl/current/inc/File/Copy/Recursive.pm (added)
+++ branches/upstream/libmojomojo-perl/current/inc/File/Copy/Recursive.pm Sun Mar 13 21:14:53 2011
@@ -1,0 +1,394 @@
+#line 1
+package File::Copy::Recursive;
+
+use strict;
+BEGIN {
+ # Keep older versions of Perl from trying to use lexical warnings
+ $INC{'warnings.pm'} = "fake warnings entry for < 5.6 perl ($])" if $] < 5.006;
+}
+use warnings;
+
+use Carp;
+use File::Copy;
+use File::Spec; #not really needed because File::Copy already gets it, but for good measure :)
+
+use vars qw(
+ @ISA @EXPORT_OK $VERSION $MaxDepth $KeepMode $CPRFComp $CopyLink
+ $PFSCheck $RemvBase $NoFtlPth $ForcePth $CopyLoop $RMTrgFil $RMTrgDir
+ $CondCopy $BdTrgWrn $SkipFlop $DirPerms
+);
+
+require Exporter;
+ at ISA = qw(Exporter);
+ at EXPORT_OK = qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir);
+$VERSION = '0.38';
+
+$MaxDepth = 0;
+$KeepMode = 1;
+$CPRFComp = 0;
+$CopyLink = eval { local $SIG{'__DIE__'};symlink '',''; 1 } || 0;
+$PFSCheck = 1;
+$RemvBase = 0;
+$NoFtlPth = 0;
+$ForcePth = 0;
+$CopyLoop = 0;
+$RMTrgFil = 0;
+$RMTrgDir = 0;
+$CondCopy = {};
+$BdTrgWrn = 0;
+$SkipFlop = 0;
+$DirPerms = 0777;
+
+my $samecheck = sub {
+ return 1 if $^O eq 'MSWin32'; # need better way to check for this on winders...
+ return if @_ != 2 || !defined $_[0] || !defined $_[1];
+ return if $_[0] eq $_[1];
+
+ my $one = '';
+ if($PFSCheck) {
+ $one = join( '-', ( stat $_[0] )[0,1] ) || '';
+ my $two = join( '-', ( stat $_[1] )[0,1] ) || '';
+ if ( $one eq $two && $one ) {
+ carp "$_[0] and $_[1] are identical";
+ return;
+ }
+ }
+
+ if(-d $_[0] && !$CopyLoop) {
+ $one = join( '-', ( stat $_[0] )[0,1] ) if !$one;
+ my $abs = File::Spec->rel2abs($_[1]);
+ my @pth = File::Spec->splitdir( $abs );
+ while(@pth) {
+ my $cur = File::Spec->catdir(@pth);
+ last if !$cur; # probably not necessary, but nice to have just in case :)
+ my $two = join( '-', ( stat $cur )[0,1] ) || '';
+ if ( $one eq $two && $one ) {
+ # $! = 62; # Too many levels of symbolic links
+ carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";
+ return;
+ }
+
+ pop @pth;
+ }
+ }
+
+ return 1;
+};
+
+my $glob = sub {
+ my ($do, $src_glob, @args) = @_;
+
+ local $CPRFComp = 1;
+
+ my @rt;
+ for my $path ( glob($src_glob) ) {
+ my @call = [$do->($path, @args)] or return;
+ push @rt, \@call;
+ }
+
+ return @rt;
+};
+
+my $move = sub {
+ my $fl = shift;
+ my @x;
+ if($fl) {
+ @x = fcopy(@_) or return;
+ } else {
+ @x = dircopy(@_) or return;
+ }
+ if(@x) {
+ if($fl) {
+ unlink $_[0] or return;
+ } else {
+ pathrmdir($_[0]) or return;
+ }
+ if($RemvBase) {
+ my ($volm, $path) = File::Spec->splitpath($_[0]);
+ pathrm(File::Spec->catpath($volm,$path,''), $ForcePth, $NoFtlPth) or return;
+ }
+ }
+ return wantarray ? @x : $x[0];
+};
+
+my $ok_todo_asper_condcopy = sub {
+ my $org = shift;
+ my $copy = 1;
+ if(exists $CondCopy->{$org}) {
+ if($CondCopy->{$org}{'md5'}) {
+
+ }
+ if($copy) {
+
+ }
+ }
+ return $copy;
+};
+
+sub fcopy {
+ $samecheck->(@_) or return;
+ if($RMTrgFil && (-d $_[1] || -e $_[1]) ) {
+ my $trg = $_[1];
+ if( -d $trg ) {
+ my @trgx = File::Spec->splitpath( $_[0] );
+ $trg = File::Spec->catfile( $_[1], $trgx[ $#trgx ] );
+ }
+ $samecheck->($_[0], $trg) or return;
+ if(-e $trg) {
+ if($RMTrgFil == 1) {
+ unlink $trg or carp "\$RMTrgFil failed: $!";
+ } else {
+ unlink $trg or return;
+ }
+ }
+ }
+ my ($volm, $path) = File::Spec->splitpath($_[1]);
+ if($path && !-d $path) {
+ pathmk(File::Spec->catpath($volm,$path,''), $NoFtlPth);
+ }
+ if( -l $_[0] && $CopyLink ) {
+ carp "Copying a symlink ($_[0]) whose target does not exist"
+ if !-e readlink($_[0]) && $BdTrgWrn;
+ symlink readlink(shift()), shift() or return;
+ } else {
+ copy(@_) or return;
+
+ my @base_file = File::Spec->splitpath($_[0]);
+ my $mode_trg = -d $_[1] ? File::Spec->catfile($_[1], $base_file[ $#base_file ]) : $_[1];
+
+ chmod scalar((stat($_[0]))[2]), $mode_trg if $KeepMode;
+ }
+ return wantarray ? (1,0,0) : 1; # use 0's incase they do math on them and in case rcopy() is called in list context = no uninit val warnings
+}
+
+sub rcopy {
+ if (-l $_[0] && $CopyLink) {
+ goto &fcopy;
+ }
+
+ goto &dircopy if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
+ goto &fcopy;
+}
+
+sub rcopy_glob {
+ $glob->(\&rcopy, @_);
+}
+
+sub dircopy {
+ if($RMTrgDir && -d $_[1]) {
+ if($RMTrgDir == 1) {
+ pathrmdir($_[1]) or carp "\$RMTrgDir failed: $!";
+ } else {
+ pathrmdir($_[1]) or return;
+ }
+ }
+ my $globstar = 0;
+ my $_zero = $_[0];
+ my $_one = $_[1];
+ if ( substr( $_zero, ( 1 * -1 ), 1 ) eq '*') {
+ $globstar = 1;
+ $_zero = substr( $_zero, 0, ( length( $_zero ) - 1 ) );
+ }
+
+ $samecheck->( $_zero, $_[1] ) or return;
+ if ( !-d $_zero || ( -e $_[1] && !-d $_[1] ) ) {
+ $! = 20;
+ return;
+ }
+
+ if(!-d $_[1]) {
+ pathmk($_[1], $NoFtlPth) or return;
+ } else {
+ if($CPRFComp && !$globstar) {
+ my @parts = File::Spec->splitdir($_zero);
+ while($parts[ $#parts ] eq '') { pop @parts; }
+ $_one = File::Spec->catdir($_[1], $parts[$#parts]);
+ }
+ }
+ my $baseend = $_one;
+ my $level = 0;
+ my $filen = 0;
+ my $dirn = 0;
+
+ my $recurs; #must be my()ed before sub {} since it calls itself
+ $recurs = sub {
+ my ($str,$end,$buf) = @_;
+ $filen++ if $end eq $baseend;
+ $dirn++ if $end eq $baseend;
+
+ $DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
+ mkdir($end,$DirPerms) or return if !-d $end;
+ chmod scalar((stat($str))[2]), $end if $KeepMode;
+ if($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth) {
+ return ($filen,$dirn,$level) if wantarray;
+ return $filen;
+ }
+ $level++;
+
+
+ my @files;
+ if ( $] < 5.006 ) {
+ opendir(STR_DH, $str) or return;
+ @files = grep( $_ ne '.' && $_ ne '..', readdir(STR_DH));
+ closedir STR_DH;
+ }
+ else {
+ opendir(my $str_dh, $str) or return;
+ @files = grep( $_ ne '.' && $_ ne '..', readdir($str_dh));
+ closedir $str_dh;
+ }
+
+ for my $file (@files) {
+ my ($file_ut) = $file =~ m{ (.*) }xms;
+ my $org = File::Spec->catfile($str, $file_ut);
+ my $new = File::Spec->catfile($end, $file_ut);
+ if( -l $org && $CopyLink ) {
+ carp "Copying a symlink ($org) whose target does not exist"
+ if !-e readlink($org) && $BdTrgWrn;
+ symlink readlink($org), $new or return;
+ }
+ elsif(-d $org) {
+ $recurs->($org,$new,$buf) if defined $buf;
+ $recurs->($org,$new) if !defined $buf;
+ $filen++;
+ $dirn++;
+ }
+ else {
+ if($ok_todo_asper_condcopy->($org)) {
+ if($SkipFlop) {
+ fcopy($org,$new,$buf) or next if defined $buf;
+ fcopy($org,$new) or next if !defined $buf;
+ }
+ else {
+ fcopy($org,$new,$buf) or return if defined $buf;
+ fcopy($org,$new) or return if !defined $buf;
+ }
+ chmod scalar((stat($org))[2]), $new if $KeepMode;
+ $filen++;
+ }
+ }
+ }
+ 1;
+ };
+
+ $recurs->($_zero, $_one, $_[2]) or return;
+ return wantarray ? ($filen,$dirn,$level) : $filen;
+}
+
+sub fmove { $move->(1, @_) }
+
+sub rmove {
+ if (-l $_[0] && $CopyLink) {
+ goto &fmove;
+ }
+
+ goto &dirmove if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
+ goto &fmove;
+}
+
+sub rmove_glob {
+ $glob->(\&rmove, @_);
+}
+
+sub dirmove { $move->(0, @_) }
+
+sub pathmk {
+ my @parts = File::Spec->splitdir( shift() );
+ my $nofatal = shift;
+ my $pth = $parts[0];
+ my $zer = 0;
+ if(!$pth) {
+ $pth = File::Spec->catdir($parts[0],$parts[1]);
+ $zer = 1;
+ }
+ for($zer..$#parts) {
+ $DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
+ mkdir($pth,$DirPerms) or return if !-d $pth && !$nofatal;
+ mkdir($pth,$DirPerms) if !-d $pth && $nofatal;
+ $pth = File::Spec->catdir($pth, $parts[$_ + 1]) unless $_ == $#parts;
+ }
+ 1;
+}
+
+sub pathempty {
+ my $pth = shift;
+
+ return 2 if !-d $pth;
+
+ my @names;
+ my $pth_dh;
+ if ( $] < 5.006 ) {
+ opendir(PTH_DH, $pth) or return;
+ @names = grep !/^\.+$/, readdir(PTH_DH);
+ }
+ else {
+ opendir($pth_dh, $pth) or return;
+ @names = grep !/^\.+$/, readdir($pth_dh);
+ }
+
+ for my $name (@names) {
+ my ($name_ut) = $name =~ m{ (.*) }xms;
+ my $flpth = File::Spec->catdir($pth, $name_ut);
+
+ if( -l $flpth ) {
+ unlink $flpth or return;
+ }
+ elsif(-d $flpth) {
+ pathrmdir($flpth) or return;
+ }
+ else {
+ unlink $flpth or return;
+ }
+ }
+
+ if ( $] < 5.006 ) {
+ closedir PTH_DH;
+ }
+ else {
+ closedir $pth_dh;
+ }
+
+ 1;
+}
+
+sub pathrm {
+ my $path = shift;
+ return 2 if !-d $path;
+ my @pth = File::Spec->splitdir( $path );
+ my $force = shift;
+
+ while(@pth) {
+ my $cur = File::Spec->catdir(@pth);
+ last if !$cur; # necessary ???
+ if(!shift()) {
+ pathempty($cur) or return if $force;
+ rmdir $cur or return;
+ }
+ else {
+ pathempty($cur) if $force;
+ rmdir $cur;
+ }
+ pop @pth;
+ }
+ 1;
+}
+
+sub pathrmdir {
+ my $dir = shift;
+ if( -e $dir ) {
+ return if !-d $dir;
+ }
+ else {
+ return 2;
+ }
+
+ pathempty($dir) or return;
+
+ rmdir $dir or return;
+}
+
+1;
+
+__END__
+
+#line 696
Modified: branches/upstream/libmojomojo-perl/current/inc/Module/Install/Catalyst.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/inc/Module/Install/Catalyst.pm?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/inc/Module/Install/Catalyst.pm (original)
+++ branches/upstream/libmojomojo-perl/current/inc/Module/Install/Catalyst.pm Sun Mar 13 21:14:53 2011
@@ -9,9 +9,9 @@
use File::Find;
use FindBin;
-use File::Copy::Recursive 'rcopy';
+use File::Copy::Recursive;
use File::Spec ();
-use Getopt::Long qw(GetOptionsFromString :config no_ignore_case);
+use Getopt::Long ();
use Data::Dumper;
my $SAFETY = 0;
@@ -30,6 +30,14 @@
sub catalyst {
my $self = shift;
+
+ if($Module::Install::AUTHOR) {
+ $self->admin->copy_package(
+ 'File::Copy::Recursive',
+ $INC{"File/Copy/Recursive.pm"},
+ );
+ }
+
print <<EOF;
*** Module::Install::Catalyst
EOF
@@ -40,7 +48,7 @@
EOF
}
-#line 77
+#line 85
sub catalyst_files {
my $self = shift;
@@ -60,25 +68,25 @@
my @path = split '-', $self->name;
for my $orig (@files) {
my $path = File::Spec->catdir( 'blib', 'lib', @path, $orig );
- rcopy( $orig, $path );
- }
-}
-
-#line 105
+ File::Copy::Recursive::rcopy( $orig, $path );
+ }
+}
+
+#line 113
sub catalyst_ignore_all {
my ( $self, $ignore ) = @_;
@IGNORE = @$ignore;
}
-#line 116
+#line 124
sub catalyst_ignore {
my ( $self, @ignore ) = @_;
push @IGNORE, @ignore;
}
-#line 125
+#line 133
# Workaround for a namespace conflict
sub catalyst_par {
@@ -104,57 +112,62 @@
EOF
}
-#line 153
+#line 161
sub catalyst_par_core {
my ( $self, $core ) = @_;
$core ? ( $PAROPTS{'B'} = $core ) : $PAROPTS{'B'}++;
}
-#line 162
+#line 170
sub catalyst_par_classes {
my ( $self, @classes ) = @_;
push @CLASSES, @classes;
}
-#line 171
+#line 179
sub catalyst_par_engine {
my ( $self, $engine ) = @_;
$ENGINE = $engine;
}
-#line 180
+#line 188
sub catalyst_par_multiarch {
my ( $self, $multiarch ) = @_;
$multiarch ? ( $PAROPTS{'m'} = $multiarch ) : $PAROPTS{'m'}++;
}
-#line 213
+#line 221
sub catalyst_par_options {
my ( $self, $optstring ) = @_;
- my %o = ();
eval "use PAR::Packer ()";
if ($@) {
warn "WARNING: catalyst_par_options ignored - you need PAR::Packer\n"
}
else {
- GetOptionsFromString($optstring, \%o, PAR::Packer->options);
+ my $p = Getopt::Long::Parser->new(config => ['no_ignore_case']);
+ my %o;
+ require Text::ParseWords;
+ {
+ local @ARGV = Text::ParseWords::shellwords($optstring);
+ $p->getoptions(\%o, PAR::Packer->options);
+ }
%PAROPTS = ( %PAROPTS, %o);
}
}
-#line 230
+#line 243
sub catalyst_par_script {
my ( $self, $script ) = @_;
$SCRIPT = $script;
}
-#line 239
+#line 252
sub catalyst_par_usage {
my ( $self, $usage ) = @_;
@@ -307,6 +320,6 @@
return 1;
}
-#line 401
+#line 414
1;
Modified: branches/upstream/libmojomojo-perl/current/lib/MojoMojo.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/lib/MojoMojo.pm?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/lib/MojoMojo.pm (original)
+++ branches/upstream/libmojomojo-perl/current/lib/MojoMojo.pm Sun Mar 13 21:14:53 2011
@@ -30,7 +30,7 @@
except => qr/^MojoMojo::Plugin::/,
require => 1;
-our $VERSION = '1.03';
+our $VERSION = '1.04';
use 5.008004;
MojoMojo->config->{authentication}{dbic} = {
Modified: branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Controller/PageAdmin.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Controller/PageAdmin.pm?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Controller/PageAdmin.pm (original)
+++ branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Controller/PageAdmin.pm Sun Mar 13 21:14:53 2011
@@ -154,10 +154,24 @@
$stash->{content} = $page->content;
$c->model("DBIC::Page")->set_paths(@$path_pages);
- # refetch page to have ->content available, else it will break in DBIC 0.08099_05 and later
- #$page = $c->model("DBIC::Page")->find( $page->id );
+ # setup redirect back to edits or view page mode.
+ my $redirect = $c->uri_for( $c->stash->{path} );
+ if ( $form->params->{submit} eq $c->localize('Save') ) {
+ $redirect .= '.edit';
+ }
+
+ # No need to update if we have no difference between browser and db.
+ if ( $c->stash->{content} && ($c->stash->{content}->body eq $form->params->{body}) ) {
+ $c->res->redirect($redirect);
+ return;
+ }
+
+ # If we get here it means we have some difference between wiki page in browser and db.
+ # TODO: Is the discard_changes necessary? Why are we discarding local changes?
+ # Are there even any local changes to $page?
$page->discard_changes;
+ # Check for changes made by another user to the same base revision.
if( $c->stash->{content} &&
$c->req->params->{version} != $c->stash->{content}->version ) {
$c->stash->{message}=$c->loc('Someone else changed the page while you edited. Your changes has been merged. Please review and save again');
@@ -175,6 +189,7 @@
$c->loc('END OF CONFLICT'));
return;
}
+
# Format content body and store the result in content.precompiled
# This speeds up MojoMojo page rendering on /.view actions
my $precompiled_body = $valid->{'body'};
@@ -191,11 +206,6 @@
unless $c->pref('disable_search');
$page->content->store_links();
- # Redirect back to edits or view page mode.
- my $redirect = $c->uri_for( $c->stash->{path} );
- if ( $form->params->{submit} eq $c->localize('Save') ) {
- $redirect .= '.edit';
- }
$c->res->redirect($redirect);
}
else {
Modified: branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Amazon.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Amazon.pm?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Amazon.pm (original)
+++ branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Amazon.pm Sun Mar 13 21:14:53 2011
@@ -78,9 +78,9 @@
=cut
sub get {
- my ($class,$id,$amazon_id)=@_;
+ my ($class,$id,$amazon_id,$secret_key)=@_;
#FIXME: devel token should be set in formatter config.
- my $amazon=Net::Amazon->new(token=>$amazon_id);
+ my $amazon=Net::Amazon->new(token=>$amazon_id,secret_key=>$secret_key);
my $response=$amazon->search(asin=>$id);
return "Unable to connect to amazon." unless $response->is_success;
($property)=$response->properties;
Added: branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Gist.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Gist.pm?rev=71358&op=file
==============================================================================
--- branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Gist.pm (added)
+++ branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/Gist.pm Sun Mar 13 21:14:53 2011
@@ -1,0 +1,105 @@
+package MojoMojo::Formatter::Gist;
+use strict;
+use warnings;
+use parent qw/MojoMojo::Formatter/;
+
+=head1 NAME
+
+MojoMojo::Formatter::Gist - Embed Gist script
+
+=head1 DESCRIPTION
+
+Embed Gist script by writing {{gist <id>}}.
+
+if you write:
+
+ {{gist 618402}}
+
+it will be formatted, like this
+
+ <script src="https://gist.github.com/618402.js"></script>
+
+then you can see the syntax highlighted source code.
+
+=head1 METHODS
+
+=head2 format_content_order
+
+The Gist formatter has no special requirements
+in terms of the order it gets run in, so it has a priority of 17.
+
+=cut
+
+sub format_content_order { 17 }
+
+=head2 format_content
+
+Calls the formatter. Takes a ref to the content as well as the context object.
+
+=cut
+
+sub format_content {
+ my ( $class, $content, $c ) = @_;
+
+ return unless $$content;
+
+ my @lines = split /\n/, $$content;
+ $$content = '';
+
+ my $re = $class->gen_re( qr/gist\s+(\d+)/ );
+
+ for my $line (@lines) {
+ if ( $line =~ m/$re/ ) {
+ $line = $class->process($c, $line, $re, $1);
+ }
+ $$content .= $line . "\n";
+ }
+
+}
+
+=head2 process
+
+Here the actual formatting is done.
+
+=cut
+sub process {
+ my ( $class, $c, $line, $re, $id) = @_;
+
+ my $gist = $c->loc('Gist Script');
+
+ if (!$id || $id !~ /^\d+$/){
+ $line =~ s/$re/"$gist: $id ". $c->loc('is not a valid id')/e;
+ return $line;
+ }
+
+ my $url = "https://gist.github.com/$id";
+
+ my $ar = $c->action->reverse;
+ if ( $ar && ($ar eq 'pageadmin/edit' || $ar eq 'jsrpc/render') ){
+ $line =~ s!$re!<div style='width: 95%;height: 90px; border: 1px black dotted;'>$gist - <a href="$url">gist:$id</a></div>!;
+ $c->stash->{precompile_off} = 1;
+ } else {
+ $line =~ s!$re!<script src="$url.js"></script>!;
+ }
+
+ return $line;
+}
+
+
+=head1 SEE ALSO
+
+L<MojoMojo> and L<Module::Pluggable::Ordered>.
+Gist is <https://gist.github.com/>.
+
+=head1 AUTHORS
+
+Dai Okabayashi, L<bayashi at cpan . org>
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Modified: branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/GoogleCalendar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/GoogleCalendar.pm?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/GoogleCalendar.pm (original)
+++ branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/GoogleCalendar.pm Sun Mar 13 21:14:53 2011
@@ -47,7 +47,6 @@
my @lines = split /\n/, $$content;
my $re = $class->gen_re(qr/gcal\s+(.*?)\s+(\d+),(\d+)\s+(\w+)/);
$$content = "";
- $c->stash->{precompile_off} = 1;
foreach my $line (@lines) {
if ( $line =~ m/$re/ ) {
Modified: branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/IDLink.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/IDLink.pm?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/IDLink.pm (original)
+++ branches/upstream/libmojomojo-perl/current/lib/MojoMojo/Formatter/IDLink.pm Sun Mar 13 21:14:53 2011
@@ -93,7 +93,6 @@
my $url = sprintf($CONF->{$site}, $id);
$line =~ s!$re!<a href="$url">$id</a>!;
- $c->stash->{precompile_off} = 1;
return $line;
}
Modified: branches/upstream/libmojomojo-perl/current/t/c/page_edit.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/t/c/page_edit.t?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/t/c/page_edit.t (original)
+++ branches/upstream/libmojomojo-perl/current/t/c/page_edit.t Sun Mar 13 21:14:53 2011
@@ -16,7 +16,7 @@
eval "use WWW::Mechanize::TreeBuilder";
plan skip_all => 'need WWW::Mechanize::TreeBuilder' if $@;
- plan tests => 21;
+ plan tests => 31;
}
use_ok('MojoMojo::Controller::Page');
@@ -86,13 +86,31 @@
<p>It also links to <a class="existingWikiWord" href="/">the root page</a> and <a class="existingWikiWord" href="/help">help</a> as well as a <span class="newWikiWord"><a title="Not found. Click to create this page." href="/totally_new_page.edit">totally new page?</a></span>.</p>
RENDERED_CONTENT
-$mech->get_ok('/totally_new_page.edit', 'make the new page');
+my $page_name = 'totally_new_page';
+$mech->get_ok("/${page_name}.edit", 'make the new page');
ok $mech->form_with_fields('body'), 'find the edit form';
ok defined $mech->field(body => <<PAGE_CONTENT), 'Set page content';
# This is a test page
PAGE_CONTENT
+ok $mech->click_button(value => 'Save'), 'click the "Save" button';
+# This totally new page should start with revision 1.
+is($schema->resultset('Page')->single({ name => $page_name })->content_version, 1, 'first version of a page');
+
+# If we save the page with the same content, then the revision should not change.
+$mech->get_ok("/${page_name}.edit", 'save the new page with same content');
+ok $mech->form_with_fields('body'), 'find the edit form';
ok $mech->click_button(value => 'Save'), 'click the "Save" button';
+is($schema->resultset('Page')->single({ name => $page_name })->content_version, 1, 'no diff on save, no version incrementing');
+
+# If we save the page with the different content, then the revision increase by 1.
+$mech->get_ok("/${page_name}.edit", 'change content of the new page');
+ok $mech->form_with_fields('body'), 'find the edit form';
+ok defined $mech->field(body => <<PAGE_CONTENT), 'save the page with different content';
+# This is NOT THE SAME page that it was before
+PAGE_CONTENT
+ok $mech->click_button(value => 'Save'), 'click the "Save" button';
+is($schema->resultset('Page')->single({ name => $page_name })->content_version, 2, 'different content new version');
$mech->get_ok('/test');
$mech->content_contains('<a class="existingWikiWord" href="/totally_new_page">','Link was updated');
Modified: branches/upstream/libmojomojo-perl/current/t/formatter_amazon.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/t/formatter_amazon.t?rev=71358&op=diff
==============================================================================
--- branches/upstream/libmojomojo-perl/current/t/formatter_amazon.t (original)
+++ branches/upstream/libmojomojo-perl/current/t/formatter_amazon.t Sun Mar 13 21:14:53 2011
@@ -2,32 +2,36 @@
use strict;
use warnings;
use Test::More;
+use Data::Dumper::Concise;
BEGIN {
use MojoMojo::Formatter::Amazon;
plan skip_all => 'Requirements not installed for Amazon Formatter'
unless MojoMojo::Formatter::Amazon->module_loaded;
- plan skip_all => 'Set AMAZON_TOKEN to your amazon API token to run Amazon tests'
+ plan skip_all => 'Set AMAZON_TOKEN to your amazon API token (access key, not the secret one) to run Amazon tests'
unless $ENV{AMAZON_TOKEN};
- plan tests => 7;
+ plan skip_all => 'Set AMAZON_SECRET_KEY to your amazon API secret access key to run Amazon tests'
+ unless $ENV{AMAZON_SECRET_KEY};
+ plan tests => 8;
};
# Formatter basics
can_ok('MojoMojo::Formatter::Amazon', qw/format_content format_content_order/);
-my $prop=MojoMojo::Formatter::Amazon->get(1558607013,$ENV{AMAZON_TOKEN});
+my $prop=MojoMojo::Formatter::Amazon->get(1558607013,$ENV{AMAZON_TOKEN}, $ENV{AMAZON_SECRET_KEY});
isa_ok($prop,'Net::Amazon::Property');
+is($prop->title, 'Higher-Order Perl: Transforming Programs with Programs', 'object title');
SKIP: {
eval { use Test::MockObject };
skip ('Test::MockObject not installed', 3) if $@;
my $o = Test::MockObject->new();
$o->set_true(qw/artists authors directors year/);
- is(MojoMojo::Formatter::Amazon->DVD($o), " -- ??1?? (1)\n\n");
- is(MojoMojo::Formatter::Amazon->Book($o), " -- ??1?? (1)\n\n");
- is(MojoMojo::Formatter::Amazon->Music($o)," -- ??1?? (1)\n\n");
+ is(MojoMojo::Formatter::Amazon->DVD($o), " -- ??1?? (1)\n\n", 'DVD formatter');
+ is(MojoMojo::Formatter::Amazon->Book($o), " -- ??1?? (1)\n\n", 'Book formatter');
+ is(MojoMojo::Formatter::Amazon->Music($o)," -- ??1?? (1)\n\n", 'Music formatter');
}
-like(MojoMojo::Formatter::Amazon->blurb($prop), qr/^\<div class="amazon"/ );
-like(MojoMojo::Formatter::Amazon->small($prop), qr/$\!.+jpg\!.+ASIN/ );
+like(MojoMojo::Formatter::Amazon->blurb($prop), qr/^\<div class="amazon"/, 'blurb format' );
+like(MojoMojo::Formatter::Amazon->small($prop), qr/^\!.+jpg\!.+ASIN/, 'small format' );
Added: branches/upstream/libmojomojo-perl/current/t/formatter_gist.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmojomojo-perl/current/t/formatter_gist.t?rev=71358&op=file
==============================================================================
--- branches/upstream/libmojomojo-perl/current/t/formatter_gist.t (added)
+++ branches/upstream/libmojomojo-perl/current/t/formatter_gist.t Sun Mar 13 21:14:53 2011
@@ -1,0 +1,68 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 7;
+use lib 't/lib';
+use HTTP::Request::Common;
+use FakeCatalystObject;
+
+BEGIN {
+ use_ok 'Catalyst::Test', 'MojoMojo';
+ use_ok 'MojoMojo::Formatter::Gist';
+}
+
+my $fake_c = FakeCatalystObject->new;
+
+{
+ my $content = "see {{gist }}";
+ MojoMojo::Formatter::Gist->format_content(\$content, $fake_c);
+ is(
+ $content,
+ qq|see {{gist }}\n|,
+ "blank (no format)",
+ );
+}
+
+{
+ my $content = "see {{gist 618402}}";
+ MojoMojo::Formatter::Gist->format_content(\$content, $fake_c);
+ is(
+ $content,
+ qq|see <script src="https://gist.github.com/618402.js"></script>\n|,
+ "normal",
+ );
+}
+
+$fake_c->set_reverse('pageadmin/edit');
+{
+ my $content = "see {{gist 618402}}";
+ MojoMojo::Formatter::Gist->format_content(\$content, $fake_c);
+ is(
+ $content,
+ qq|see <div style='width: 95%;height: 90px; border: 1px black dotted;'>Faking localization... Gist Script ...fake complete. - <a href="https://gist.github.com/618402">gist:618402</a></div>\n|,
+ "edit / valid tag",
+ );
+}
+
+$fake_c->set_reverse('jsrpc/render');
+{
+ my $content = "see {{gist 618402}}";
+ MojoMojo::Formatter::Gist->format_content(\$content, $fake_c);
+ is(
+ $content,
+ qq|see <div style='width: 95%;height: 90px; border: 1px black dotted;'>Faking localization... Gist Script ...fake complete. - <a href="https://gist.github.com/618402">gist:618402</a></div>\n|,
+ "jsrpc/render / valid tag",
+ );
+}
+
+$fake_c->set_reverse('');
+{
+ my $content = "see {{gist 123invalid123}}";
+ MojoMojo::Formatter::Gist->format_content(\$content, $fake_c);
+ is(
+ $content,
+ qq|see {{gist 123invalid123}}\n|,
+ "invalid ID",
+ );
+}
+
More information about the Pkg-perl-cvs-commits
mailing list