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