Socialtext-Resting-Utils-0.21/0000755000374100037410000000000011323242063015252 5ustar lukeclukecSocialtext-Resting-Utils-0.21/t/0000755000374100037410000000000011323242063015515 5ustar lukeclukecSocialtext-Resting-Utils-0.21/t/rester.conf0000644000374100037410000000031111323242054017663 0ustar lukeclukecusername = user-name password = CRYPTED_53616c7465645f5fbbf5d55045f42def3fafbc460b8f76e45cdd802553c46128 workspace = work-space server = http://socialtext.net class = Socialtext::Resting::Mock Socialtext-Resting-Utils-0.21/t/tagged-pages.t0000644000374100037410000000137111131746306020242 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Test::More tests => 4; use Socialtext::Resting::Mock; BEGIN { use_ok 'Socialtext::Resting::TaggedPages', 'tagged_pages'; } my $r = Socialtext::Resting::Mock->new; $r->{_get_pages} = [ { page_id => 'none', tags => [] }, { page_id => 'one', tags => ['a'] }, { page_id => 'two', tags => [ 'a', 'b' ] }, ]; Untagged_pages: { my $pages = tagged_pages(rester => $r, notags => 1); is_deeply $pages, ['none'], 'page has no tags'; } One_tag: { my $pages = tagged_pages(rester => $r, tags => ['a']); is_deeply $pages, [qw/one two/], 'page has one tag'; } Two_tags: { my $pages = tagged_pages(rester => $r, tags => ['a', 'b']); is_deeply $pages, ['two'], 'page has two tags'; } Socialtext-Resting-Utils-0.21/t/extralink.txt0000644000374100037410000000015711136445004020264 0ustar lukeclukecMonkey .extralink [Foo Bar] Cows .extralink .extralink [Bar Baz] Bears are godless killing machines .extralink Socialtext-Resting-Utils-0.21/t/default-rester.t0000644000374100037410000000033711131746306020641 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Test::More tests => 2; BEGIN { use_ok 'Socialtext::Resting::DefaultRester'; } my $rester = Socialtext::Resting::DefaultRester->new; isa_ok $rester, 'Socialtext::Resting'; Socialtext-Resting-Utils-0.21/t/table-config.t0000644000374100037410000000115411131746306020243 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 5; use lib 'lib'; BEGIN { use_ok 'Socialtext::WikiObject::TableConfig'; use_ok 'Socialtext::Resting::Mock'; } my $rester = Socialtext::Resting::Mock->new; sub new_wikiobject { Socialtext::WikiObject::TableConfig->new( rester => $rester, @_ ); } Simple_table: { $rester->put_page('Foo', < 'Foo'); my $table = $wo->table; is ref($table), 'HASH'; is $table->{foo}, 'bar'; is $table->{perl}, 'python'; } Socialtext-Resting-Utils-0.21/t/pod-coverage.t0000644000374100037410000000025411131746306020264 0ustar lukeclukec#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); Socialtext-Resting-Utils-0.21/t/00-load.t0000644000374100037410000000033711131746306017047 0ustar lukeclukec#!perl -T use Test::More tests => 2; BEGIN { use_ok 'Socialtext::Resting::Utils'; use_ok 'Socialtext::EditPage'; } diag( "Testing Socialtext::Resting::Utils $Socialtext::Resting::Utils::VERSION, Perl $], $^X" ); Socialtext-Resting-Utils-0.21/t/getopt-test.pl0000644000374100037410000000064711131746306020346 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use lib 'lib'; use Socialtext::Resting::Getopt qw/get_rester/; use Getopt::Long; my $rester = get_rester(); my $monkey = ''; GetOptions( 'monkey' => \$monkey ); print "Monkey=$monkey ARGV=@ARGV\n"; if ($rester) { for my $attr (qw(server username password workspace)) { my $val = $rester->$attr(); next unless $val; print "$attr=$val\n"; } } exit; Socialtext-Resting-Utils-0.21/t/pod.t0000644000374100037410000000021411131746306016467 0ustar lukeclukec#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Socialtext-Resting-Utils-0.21/t/mock-editor.pl0000755000374100037410000000046511131746306020305 0ustar lukeclukec#!/usr/bin/perl # Make everything ALLCAPS my $name = shift; open(my $fh, $name) or die "Can't open $name: $!"; local $/; my $content = <$fh>; close $fh; $content =~ s/([a-z])/uc($1)/eg; open(my $wfh, ">$name") or die "Can't open $name: $!"; print $wfh $content; close $wfh or die "Can't write $name: $!"; Socialtext-Resting-Utils-0.21/t/object.t0000644000374100037410000002112211314207132017144 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 15; use lib 'lib'; BEGIN { use_ok 'Socialtext::WikiObject'; use_ok 'Socialtext::Resting::Mock'; } my $rester = Socialtext::Resting::Mock->new; my @pages = load_test_data(); for my $p (@pages) { object_ok( page => $p->{page}, page_content => $p->{page_content}, expected => $p->{expected}, ); } No_wiki_supplied: { eval { Socialtext::WikiObject->new }; like $@, qr/rester is mandatory!/; } Deep_initial_heading: { object_ok( page => 'Test Page', page_content => <<'EOT', Stuff ^^^^ Currently listening to: A song ^^ Getting oriented Food EOT expected => { headings => [ 'Currently listening to', 'Getting oriented', ], page => 'Test Page', rester => $rester, text => "Stuff\n", 'currently listening to' => "A song\n", 'Currently listening to' => "A song\n", 'Getting oriented' => "Food\n", 'getting oriented' => "Food\n", }, ); } Items_and_text: { object_ok( page => 'Test Page', page_content => <<'EOT', ^ Contact Info: * Item 1 * Item 2 Other text More text EOT expected => { page => 'Test Page', rester => $rester, 'Contact Info' => { items => [ 'Item 1', 'Item 2' ], text => "Other text\nMore text\n", }, 'contact info' => { items => [ 'Item 1', 'Item 2' ], text => "Other text\nMore text\n", }, headings => ['Contact Info'], }, ); } Simple_tables: { my $table_one = [ [ '*Search Term*', '*Expected Results*' ], [ 'foo', q{exact:Pages containing 'foo'} ], [ '=foo', q{exact:Titles containing 'foo'} ], ]; my $table_two = [ ['Spam spam spam', 'Water bottle'], ['whiteboards and pens', 'with smelly markers'], ]; object_ok( page => 'Table Page', page_content => <<'EOT', | *Search Term* | *Expected Results* | | foo | exact:Pages containing 'foo' | | =foo | exact:Titles containing 'foo' | ^ Other things: These are some things I see: | Spam spam spam | Water bottle | | whiteboards and pens | with smelly markers | EOT expected => { page => 'Table Page', rester => $rester, table => $table_one, 'Other things' => { table => $table_two, text => "These are some things I see:\n", }, 'other things' => { table => $table_two, text => "These are some things I see:\n", }, headings => ['Other things'], }, ); } exit; sub object_ok { my %opts = @_; $rester->put_page($opts{page}, $opts{page_content}); my $o = Socialtext::WikiObject->new( rester => $rester, page => $opts{page}, ); isa_ok $o, 'Socialtext::WikiObject'; is_deeply $o, $opts{expected}, $opts{page}; } sub load_test_data { my @data; { my $text = <<'EOT'; ^ Theme: Initial iteration to get the web interface up on our internal beta server. ^ People: # lukec - 25h # pancho - 25h ^ Story Boards: ^^ [SetupApache] ^^^ Tasks: # install base OS on app-beta (2h) # install latest Apache2 with mod_perl2 (2h) # Configure Apache2 to start on boot (1h) ^^ [ModPerl HelloWorld] ^^^ Tasks: # Create Awesome-App package with hello world handler (1h) # Install Awesome-App package into system perl on app-beta (1h) # Configure mod_perl2 to have Awesome::App handler (1h) ^^ [Styled Homepage] ^^^ Tasks: # Integrate mockups into Awesome-App (1h) # Update Awesome-App on app-beta (1h) ^ Other Information: Details go here. * Bullet one * Bullet two EOT # Build up the data structure in reverse, as there are several # duplicate nodes my $theme = 'Initial iteration to get the web interface up on our ' . "internal beta server.\n"; my $people = [ 'lukec - 25h', 'pancho - 25h', ]; my $setup_apache_tasks = [ 'install base OS on app-beta (2h)', 'install latest Apache2 with mod_perl2 (2h)', 'Configure Apache2 to start on boot (1h)', ]; my $setup_apache = { name => '[SetupApache]', tasks => $setup_apache_tasks, Tasks => $setup_apache_tasks, }; my $mod_perl_tasks = [ 'Create Awesome-App package with hello world handler (1h)', 'Install Awesome-App package into system perl on app-beta (1h)', 'Configure mod_perl2 to have Awesome::App handler (1h)', ]; my $mod_perl = { name => '[ModPerl HelloWorld]', tasks => $mod_perl_tasks, Tasks => $mod_perl_tasks, }; my $styled_homepage_tasks = [ 'Integrate mockups into Awesome-App (1h)', 'Update Awesome-App on app-beta (1h)', ]; my $styled_homepage = { name => '[Styled Homepage]', tasks => $styled_homepage_tasks, Tasks => $styled_homepage_tasks, }; my $storyboards = { name => 'Story Boards', '[SetupApache]' => $setup_apache, '[setupapache]' => $setup_apache, '[ModPerl HelloWorld]' => $mod_perl, '[modperl helloworld]' => $mod_perl, '[Styled Homepage]' => $styled_homepage, '[styled homepage]' => $styled_homepage, items => [ $setup_apache, $mod_perl, $styled_homepage, ], }; my $other_info = { text => "Details go here.\n", items => [ 'Bullet one', 'Bullet two', ], }; my $page_name = 'data structure correct'; my $page_data = { page => $page_name, rester => $rester, theme => $theme, Theme => $theme, People => $people, people => $people, 'Story Boards' => $storyboards, 'story boards' => $storyboards, 'Other Information' => $other_info, 'other information' => $other_info, items => [ $storyboards, ], headings => [ 'Theme', 'People', 'Story Boards', '[SetupApache]', 'Tasks', '[ModPerl HelloWorld]', 'Tasks', '[Styled Homepage]', 'Tasks', 'Other Information', ], }; push @data, { page => $page_name, page_content => $text, expected => $page_data, }; } { my $text = < 'Top of the morning', text => "Alpha Bravo\n", 'Ball Tricks' => $ball_tricks, 'ball tricks' => $ball_tricks, 'Club Tricks' => $club_tricks, 'club tricks' => $club_tricks, }; my $page_name = 'text with items'; my $page_data = { page => $page_name, rester => $rester, 'Top of the morning' => $morning_top, 'top of the morning' => $morning_top, items => [ $morning_top, ], headings => [ 'Top of the morning', 'Ball Tricks', 'Club Tricks', ], }; push @data, { page => $page_name,, page_content => $text, expected => $page_data, }; } { my $text = < $page_name, rester => $rester, text => "Page with no title:\n", items => [ 'one', 'two', ], }; push @data, { page => $page_name, page_content => $text, expected => $page_data, }; } return @data; } Socialtext-Resting-Utils-0.21/t/wiki-localcopy.t0000644000374100037410000000733411246035456020651 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Test::More qw/no_plan/; use Socialtext::Resting::Mock; use Socialtext::EditPage; # _read_file and _write_file use File::Path qw/mkpath rmtree/; use Fatal qw/mkpath rmtree/; use JSON::XS; BEGIN { use_ok 'Socialtext::Resting::LocalCopy'; } # Test data my %testdata = ( foo => { json => <<'EOT', {"page_uri":"https://www.socialtext.net/st-sandbox/index.cgi?foo","page_id":"foo","name":"Foo","wikitext":"Foocontent\n","modified_time":1188427118,"tags":["Footag"],"uri":"foo","revision_id":20070829223838,"html":"
\n

\nFoocontent

\n
\n","last_edit_time":"2007-08-29 22:38:38 GMT","last_editor":"luke.closs@socialtext.com","revision_count":15} EOT tag => 'Footag', expected => { page_id => 'foo', name => 'Foo', wikitext => "Foocontent\n", tags => ['Footag'], }, }, bar => { json => <<'EOT', {"page_uri":"https://www.socialtext.net/st-sandbox/index.cgi?bar","page_id":"bar","name":"Bar","wikitext":"Barcontent\n","modified_time":1188427118,"tags":["Bartag"],"uri":"bar","revision_id":20070829223838,"html":"
\n

\nBarcontent

\n
\n","last_edit_time":"2007-08-29 22:38:38 GMT","last_editor":"luke.closs@socialtext.com","revision_count":15} EOT tag => 'Bartag', expected => { page_id => 'bar', name => 'Bar', wikitext => "Barcontent\n", tags => ['Bartag'], }, }, ); Simple_pull_push: { my $data = $testdata{foo}; my $src = _setup_rester('foo'); my $src_lc = Socialtext::Resting::LocalCopy->new( rester => $src ); my $tmpdir = _make_tempdir(); $src_lc->pull(dir => $tmpdir); # Test that the content was saved _saved_ok($tmpdir, $data); # Push the content up to a workspace my $dst = Socialtext::Resting::Mock->new; my $dst_lc = Socialtext::Resting::LocalCopy->new( rester => $dst ); $dst_lc->push(dir => $tmpdir); # Test that the workspace was populated correctly is $dst->get_page($data->{expected}{name}), $data->{expected}{wikitext}, 'dst wikitext'; is_deeply [ $dst->get_pagetags($data->{expected}{name}) ], $data->{expected}{tags}, 'dst tags'; } Pull_by_tag: { my $data = $testdata{foo}; my $tag = $data->{expected}{tags}[0]; my $src = _setup_rester('foo', 'bar'); my $src_lc = Socialtext::Resting::LocalCopy->new( rester => $src ); my $tmpdir = _make_tempdir(); $src_lc->pull(dir => $tmpdir, tag => $tag); # Test that the content was saved _saved_ok($tmpdir, $data); # Test that the other page wasn't saved ok !-e "$tmpdir/bar", 'bar does not exist'; } # Note Attachment handling is not yet implemented exit; { my $dir; sub _make_tempdir { $dir = "t/localstore.$$"; rmtree $dir if -d $dir; mkpath $dir; END { rmtree $dir if $dir and -d $dir } return $dir; } } sub _setup_rester { my $r = Socialtext::Resting::Mock->new; for (@_) { my $name = $_; my $data = $testdata{$name}; $r->put_page($data->{expected}{name}, $data->{json}); $r->put_pagetag($data->{expected}{name}, $data->{tag}); }; return $r; } sub _saved_ok { my $tmpdir = shift; my $data = shift; my $wikitext_file = "$tmpdir/$data->{expected}{page_id}"; ok -e $wikitext_file, "-e $wikitext_file"; my $json_file = "$wikitext_file.json"; ok -e $json_file, "-e $json_file"; my $json; eval { $json = decode_json( Socialtext::EditPage::_read_file($json_file) ) }; is $@, ''; $json->{wikitext} = Socialtext::EditPage::_read_file($wikitext_file); is_deeply $json, $data->{expected}, 'json object matches'; } Socialtext-Resting-Utils-0.21/t/factory.t0000644000374100037410000000127111131746306017360 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Test::More tests => 3; use Socialtext::Resting::Mock; BEGIN { use_ok 'Socialtext::WikiObject::Factory'; } my $rester = Socialtext::Resting::Mock->new; No_magic_wikobject_tag: { $rester->put_page('Foo', "baz\n"); my $wo = Socialtext::WikiObject::Factory->new( rester => $rester, page => 'Foo', ); isa_ok $wo, 'Socialtext::WikiObject'; } Yaml_object: { $rester->put_page('Foo', "bar: baz\n"); $rester->put_pagetag('Foo', '.wikiobject=YAML'); my $wo = Socialtext::WikiObject::Factory->new( rester => $rester, page => 'Foo', ); isa_ok $wo, 'Socialtext::WikiObject::YAML'; } Socialtext-Resting-Utils-0.21/t/extraclude.txt0000644000374100037410000000016311131746306020424 0ustar lukeclukecMonkey .extraclude [Foo Bar] Cows .extraclude .extraclude [Bar Baz] Bears are godless killing machines .extraclude Socialtext-Resting-Utils-0.21/t/wikedit.t0000644000374100037410000000066211171543415017354 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Test::More tests => 2; my $script = "bin/wikedit"; my $perl = "$^X -Ilib"; like qx($perl -c $script 2>&1), qr/syntax OK/, "$script compiles ok"; Write_to_file: { my $file = "t/out.$$"; END { unlink $file if $file and -e $file } unlink $file if -e $file; like qx($perl $script --rester-config t/rester.conf -o $file Foo), qr/Wrote Foo content to \Q$file\E/; } Socialtext-Resting-Utils-0.21/t/getopt.t0000644000374100037410000000274111314207132017206 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Test::More tests => 51; BEGIN { use_ok 'Socialtext::Resting::Getopt', 'get_rester'; } No_args: { run_ok(''); } App_args: { run_ok("--monkey", Monkey => 1); run_ok("foo bar", ARGV => 'foo bar'); } Rester_options: { run_ok("--server foo", server => 'foo'); run_ok("--workspace monkey", workspace => 'monkey'); } Shorthand: { run_ok("-s foo", server => 'foo'); run_ok("-w monkey", workspace => 'monkey'); } sub run_ok { my $args = shift; my %args = ( username => 'user-name', password => 'pass-word', workspace => 'work-space', server => 'http://socialtext.net', monkey => '', ARGV => '', @_, ); my @tests = @_; open(my $fh, ">t/rester.conf") or die; print $fh <; close $fh; eval 'require Crypt::CBC'; SKIP: { skip "no Crypt::CBC", 1 if $@; like $contents, qr/password = CRYPTED_\S+/, 'pw was crypted'; } } } 1; Socialtext-Resting-Utils-0.21/t/pre-block.t0000644000374100037410000000132711131746306017571 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 4; use lib 'lib'; BEGIN { use_ok 'Socialtext::WikiObject::PreBlock'; use_ok 'Socialtext::Resting::Mock'; } my $rester = Socialtext::Resting::Mock->new; sub new_wikiobject { Socialtext::WikiObject::PreBlock->new( rester => $rester, @_ ); } Simple_pre_block: { $rester->put_page('Foo', ".pre\nMonkey\n.pre\n"); my $wo = new_wikiobject(page => 'Foo'); is $wo->pre_block, "Monkey\n"; } Pre_block_with_surrownding_content: { $rester->put_page('Foo', < 'Foo'); is $wo->pre_block, "Monkey\n"; } Socialtext-Resting-Utils-0.21/t/yaml-object.t0000644000374100037410000000137611131746306020125 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 7; use lib 'lib'; BEGIN { use_ok 'Socialtext::WikiObject::YAML'; use_ok 'Socialtext::Resting::Mock'; } my $rester = Socialtext::Resting::Mock->new; sub new_wikiobject { Socialtext::WikiObject::YAML->new( rester => $rester, @_ ); } Simple_yaml: { $rester->put_page('Foo', "foo: bar\n"); my $wo = new_wikiobject(page => 'Foo'); is $wo->{foo}, 'bar'; is_deeply $wo->as_hash, { foo => 'bar' }; } YAML_Lists: { $rester->put_page('Foo', < 'Foo'); is_deeply $wo->{Foo}, [qw(bar baz)]; is_deeply $wo->{foo}, $wo->{Foo}; is_deeply $wo->as_hash, { Foo => [qw(bar baz)] }; } Socialtext-Resting-Utils-0.21/t/edit-page.t0000644000374100037410000001675511172177126017570 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Test::More tests => 34; use lib 'lib'; use JSON::XS; BEGIN { use_ok 'Socialtext::EditPage'; use_ok 'Socialtext::Resting::Mock'; } # Don't use a real editor $ENV{EDITOR} = 't/mock-editor.pl'; Regular_edit: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', 'Monkey'); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page(page => 'Foo'); is $r->get_page('Foo')->{content}, 'MONKEY'; } Edit_no_change: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', 'MONKEY'); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page(page => 'Foo'); # relies on mock rester->get_page to delete from the hash is $r->get_page('Foo'), 'Foo not found'; } Edit_with_callback: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', 'Monkey'); my $ep = Socialtext::EditPage->new(rester => $r); my $cb = sub { return "Ape\n\n" . shift }; $ep->edit_page(page => 'Foo', callback => $cb); is $r->get_page('Foo')->{content}, "Ape\n\nMONKEY"; } Edit_with_edit_summary_callback: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', 'Monkey'); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page( page => 'Foo', callback => sub { return "Ape\n\n" . shift }, summary_callback => sub {'o hai'}, ); my $page = $r->get_page('Foo'); is $page->{content}, "Ape\n\nMONKEY"; is $page->{edit_summary}, 'o hai'; } Edit_with_tag: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', 'Monkey'); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page(page => 'Foo', tags => 'Chimp'); is $r->get_page('Foo')->{content}, 'MONKEY'; is_deeply [$r->get_pagetags('Foo')], ['Chimp']; } Edit_with_tags: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', 'Monkey'); my $ep = Socialtext::EditPage->new(rester => $r); my $tags = [qw(one two three)]; $ep->edit_page(page => 'Foo', tags => $tags); is $r->get_page('Foo')->{content}, 'MONKEY'; is_deeply [ $r->get_pagetags('Foo') ], $tags; } Edit_with_collision: { SKIP: { unless (qx(which merge) =~ /merge/) { skip "No merge tool available", 1; } close STDIN; my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', "Monkey\n"); $r->put_page('Foo', "Ape\n"); $r->die_on_put(412); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page(page => 'Foo'); my $expected_page = <>>>>>> NEW EDIT EOT is $r->get_page('Foo')->{content}, $expected_page; } } Extraclude: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', "Monkey\n"); # Load up a fancy faked editor that copies in an extraclude. my $fancy_cp = File::Temp->new(); chmod 0755, $fancy_cp->filename; print $fancy_cp "#!/bin/sh\ncp t/extraclude.txt \$1\n"; $fancy_cp->close(); local $ENV{EDITOR} = $fancy_cp->filename; my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page(page => 'Foo'); is $r->get_page('Foo')->{content}, <get_page('Foo Bar'), "Cows\n"; is $r->get_page('Bar Baz'), "Bears are godless killing machines\n"; } Extralink: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', "Monkey\n"); # Load up a fancy faked editor that copies in an extralink. my $fancy_cp = File::Temp->new(); chmod 0755, $fancy_cp->filename; print $fancy_cp "#!/bin/sh\ncp t/extralink.txt \$1\n"; $fancy_cp->close(); local $ENV{EDITOR} = $fancy_cp->filename; my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page(page => 'Foo'); is $r->get_page('Foo')->{content}, <get_page('Foo Bar'), "Cows\n"; is $r->get_page('Bar Baz'), "Bears are godless killing machines\n"; } Extraclude_in_page_content: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', <put_page('FOO BAR', ''); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page(page => 'Foo'); # $EDITOR will uc() everything is $r->get_page('Foo')->{content}, <get_page('FOO BAR'), ''; } Pull_includes: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', <put_page('Bar', "Bar page\n"); $r->put_page('Baz Defrens', "Baz page\n"); my $ep = Socialtext::EditPage->new(rester => $r, pull_includes => 1); $ep->edit_page(page => 'Foo'); # $EDITOR will uc() everything is $r->get_page('Foo')->{content}, <get_page('BAR'), "BAR PAGE\n"; is $r->get_page('BAZ DEFRENS'), "BAZ PAGE\n"; } Edit_last_page: { my $r = Socialtext::Resting::Mock->new; my @tagged_pages = ( { modified_time => 3, name => 'Newer', page_id => 'Newer', }, { modified_time => 1, name => 'Older', page_id => 'Older', }, ); $r->set_taggedpages('coffee', encode_json(\@tagged_pages)); $r->put_page('Newer', 'Newer'); $r->put_page('Older', 'Older'); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_last_page(tag => 'coffee'); # $EDITOR will uc() everything is $r->get_page('Newer')->{content}, 'NEWER'; is $r->get_page('Older'), 'Older'; } Edit_from_template: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Empty', 'Empty not found'); $r->put_page('Pookie', 'Template page'); $r->put_pagetag('Pookie', 'Pumpkin'); $r->response->code(404); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page( page => 'Empty', template => 'Pookie', ); is $r->get_page('Empty')->{content}, 'TEMPLATE PAGE'; is_deeply [$r->get_pagetags('Empty')], ['Pumpkin']; } Template_when_page_already_exists: { my $r = Socialtext::Resting::Mock->new; $r->put_page('Foo', 'Monkey'); $r->put_page('Pookie', 'Template page'); $r->response->code(200); my $ep = Socialtext::EditPage->new(rester => $r); $ep->edit_page( page => 'Foo', template => 'Pookie', ); is $r->get_page('Foo')->{content}, 'MONKEY'; } Failed_Edit: { my $r = Socialtext::Resting::Mock->new; $r->workspace('Foo'); # Successful edit my $ep = Socialtext::EditPage->new(rester => $r); unlink "baz.sav"; unlink "baz.sav.1"; { no warnings 'redefine'; *Socialtext::Resting::Mock::put_page = sub { die "shoot" }; } eval { # Failed edit $ep->edit_page(page => 'Baz', callback => sub {"Failed"}); }; ok $@, "Edit failed"; is $r->get_page('Baz'), 'Baz not found'; ok -f 'baz.sav', "baz.sav exists"; is _read_file('baz.sav'), 'Failed', "content is correct"; eval { # Failed edit $ep->edit_page(page => 'Baz', callback => sub {"Failed again"}); }; ok -f 'baz.sav.1', "baz.sav exists"; is _read_file('baz.sav.1'), 'Failed again', "content is correct"; } sub _read_file { my $filename = shift; open(my $fh, $filename) or die "unable to open $filename $!\n"; my $new_content; { local $/; $new_content = <$fh>; } close $fh; return $new_content; } Socialtext-Resting-Utils-0.21/lib/0000755000374100037410000000000011323242063016020 5ustar lukeclukecSocialtext-Resting-Utils-0.21/lib/Socialtext/0000755000374100037410000000000011323242063020137 5ustar lukeclukecSocialtext-Resting-Utils-0.21/lib/Socialtext/WikiObject/0000755000374100037410000000000011323242063022171 5ustar lukeclukecSocialtext-Resting-Utils-0.21/lib/Socialtext/WikiObject/YAML.pm0000644000374100037410000000250011131746306023274 0ustar lukeclukecpackage Socialtext::WikiObject::YAML; use strict; use warnings; use base 'Socialtext::WikiObject::PreBlock'; use YAML; =head1 NAME Socialtext::WikiObject::YAML - Parse page content as YAML =cut our $VERSION = '0.01'; =head1 METHODS =head2 parse_wikitext() Override parent method to load the wikitext as YAML. =cut sub parse_wikitext { my $self = shift; my $wikitext = shift; $self->SUPER::parse_wikitext($wikitext); $wikitext = $self->pre_block; my $data = {}; eval { $data = Load($wikitext) }; $data->{yaml_error} = $@ if $@; $self->{_hash} = $data; # Store the data into $self for my $k (keys %$data) { $self->{$k} = $self->{lc $k} = $data->{$k}; } } =head2 as_hash Return the parsed YAML as a hash. =cut sub as_hash { $_[0]->{_hash} } # TODO - Add AUTOLOADed methods? =head1 AUTHOR Luke Closs, C<< >> =head1 BUGS Please report any bugs or feature requests to L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2007 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/WikiObject/TableConfig.pm0000644000374100037410000000213211131746306024710 0ustar lukeclukecpackage Socialtext::WikiObject::TableConfig; use strict; use warnings; use base 'Socialtext::WikiObject'; =head1 NAME Socialtext::WikiObject::TableConfig - Extract a table into a hash =cut our $VERSION = '0.01'; =head1 METHODS =head2 table Return a hashref to the parsed table. =cut sub table { my $self = shift; my $table = $self->{table} or die "Can't find a table on the page!\n"; if ($table->[0][0] =~ m/^\*.+\*$/) { shift @$table; # remove the table header } my %results; for my $r (@$table) { $results{$r->[0]} = $r->[1]; } return \%results; } =head1 AUTHOR Luke Closs, C<< >> =head1 BUGS Please report any bugs or feature requests to L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2007 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/WikiObject/PreBlock.pm0000644000374100037410000000215011131746306024234 0ustar lukeclukecpackage Socialtext::WikiObject::PreBlock; use strict; use warnings; use base 'Socialtext::WikiObject'; =head1 NAME Socialtext::WikiObject::PreBlock - Parse out the first '.pre' block =cut our $VERSION = '0.01'; =head1 METHODS =head2 parse_wikitext() Override parent method to load the pre block =cut sub parse_wikitext { my $self = shift; my $wikitext = shift; # Load the YAML $wikitext =~ s/^.*?\.pre\n(.+)\.pre.+$/$1/s; chomp $wikitext; $wikitext .= "\n"; $self->{_pre_block} = $wikitext; } =head2 pre_block Return the parsed .pre block =cut sub pre_block { $_[0]->{_pre_block} } =head1 AUTHOR Luke Closs, C<< >> =head1 BUGS Please report any bugs or feature requests to L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2007 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/WikiObject/Factory.pm0000644000374100037410000000373411131746306024153 0ustar lukeclukecpackage Socialtext::WikiObject::Factory; use strict; use warnings; use Carp qw/croak/; =head1 NAME Socialtext::WikiObject::Factory - Create an approprate WikiObject from Magic Tags =cut our $VERSION = '0.01'; =head1 SYNOPSIS # Set a magic tag to define WikiObject subclass $rester->put_page($page_name, $page_text); $rester->put_pagetag($page_name, '.wikiobject=YAML'); # Use the factory to create the appropriate class my $wo = Socialtext::WikiObject::Factory->new( rester => $rester, page => $page_name, ); isa_ok $wo, 'Socialtext::WikiObject::YAML'; =head1 DESCRIPTION Socialtext::WikiObject::Factory reads magic tags on a page, and then creates a WikiObject of the appropriate class, as defined in the magic tag. =head1 FUNCTIONS =head2 new( %opts ) Create a new wiki object. Options: =over 4 =item rester Users must provide a Socialtext::Resting object setup to use the desired workspace and server. =item page The page to load. Mandatory. =back =cut sub new { my (undef, %opts) = @_; croak "rester is mandatory!" unless $opts{rester}; croak "page is mandatory!" unless $opts{page}; my $class = 'Socialtext::WikiObject'; my $rester = $opts{rester}; my @tags = $rester->get_pagetags($opts{page}); for my $t (@tags) { if ($t =~ m/^\.wikiobject=(.+)$/) { $class .= '::' . ucfirst($1); last; } } eval "require $class"; die if $@; return $class->new(%opts); } =head1 AUTHOR Luke Closs, C<< >> =head1 BUGS Please report any bugs or feature requests to L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2007 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/Resting/0000755000374100037410000000000011323242063021552 5ustar lukeclukecSocialtext-Resting-Utils-0.21/lib/Socialtext/Resting/DefaultRester.pm0000644000374100037410000001174411246035455024701 0ustar lukeclukecpackage Socialtext::Resting::DefaultRester; use strict; use warnings; use Socialtext::Resting; use Sys::Hostname qw/hostname/; =head1 NAME Socialtext::Resting::DefaultRester - load a rester from a config file. =cut our $VERSION = '0.02'; =head1 SYNOPSIS Load server, workspace and username from a file, so you don't need to specify that for every program using Socialtext::Resting. use Socialtext::Resting::DefaultRester; my $rester = Socialtext::Resting::DefaultRester->new; print $rester->get_page('Foo'); =head1 FUNCTIONS =head2 new Create a new Default Rester by using values from ~/.wikeditrc. =head3 Options: =over 4 =item rester-config File to use as the config file. Defaults to $ENV{HOME}/.wikeditrc. =item class Specifies the rester class to use. Defaults to L. =item * All other args are passed through to the rester class's new(). =back =head3 Rester Config File The config file is expected to be in the following format: server = your-server workspace = some-workspace username = your-user password = your-password Your password will become crypted the first time it is loaded if Crypt::CBC is installed. Alternately, you can use this format: server = your-server workspace = some-workspace user_cookie = an-NLW-user-cookie =cut my $home = $ENV{HOME} || "~"; our $CONFIG_FILE = "$home/.wikeditrc"; sub new { my $class = shift; my %args = (@_); for my $k (keys %args) { delete $args{$k} unless defined $args{$k}; } my $config_file = delete $args{'rester-config'} || $CONFIG_FILE; my %opts = ( _load_config($config_file), %args, ); my $rest_class = delete $opts{class} || 'Socialtext::Resting'; eval "require $rest_class"; die if $@; return $rest_class->new(%opts); } sub _load_config { my $file = shift; my $second_try = shift; unless (-e $file) { open(my $fh, ">$file") or die "Can't open $file: $!"; print $fh <) { if (/^(\w+)\s*=\s*(\S+)\s*$/) { my ($key, $val) = (lc($1), $2); $val =~ s#/$## if $key eq 'server'; $opts{$key} = $val; } } my $pw = $opts{password}; if (!$second_try and -w $file and $pw and $pw !~ /^CRYPTED_/) { _change_password($file, $opts{password}) or return _load_config($file, 'i already tried once'); } if ($opts{password} and $opts{password} =~ m/^CRYPTED_(.+)/) { eval 'require Crypt::CBC'; if ($@) { delete $opts{password}; } else { my $new_pw = _decrypt($1); $opts{password} = $new_pw; } } return %opts; } sub _change_password { my $file = shift; eval 'require Crypt::CBC'; return 0 if $@; my $old_pw = shift; my $new_pw = 'CRYPTED_' . _encrypt($old_pw); local $/ = undef; open(my $fh, $file) or die "Can't open $file: $!"; my $contents = <$fh>; $contents =~ s/password\s*=\s*\Q$old_pw\E/password = $new_pw/m; close $fh; open(my $wfh, ">$file") or die "Can't open $file for writing: $!"; print $wfh $contents; close $wfh or die "Can't write $file: $!"; return 1; } sub _encrypt { my $from = shift; my $crypt = Crypt::CBC->new( -key => hostname(), -salt => 1, -header => 'salt', ); return $crypt->encrypt_hex($from); } sub _decrypt { my $from = shift; my $crypt = Crypt::CBC->new( -key => hostname(), -salt => 1, -header => 'salt', ); return $crypt->decrypt_hex($from); } =head1 AUTHOR Luke Closs, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Socialtext::Resting::DefaultRester You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2006 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/Resting/Mock.pm0000644000374100037410000001134711131746306023015 0ustar lukeclukecpackage Socialtext::Resting::Mock; use strict; use warnings; use HTTP::Response; =head1 NAME Socialtext::Resting::Mock - Fake rester =head1 SYNOPSIS my $rester = Socialtext::Resting::Mock->(file => 'foo'); # returns content of 'foo' $rester->get_page('bar'); =cut our $VERSION = '0.04'; =head1 FUNCTIONS =head2 new( %opts ) Create a new fake rester object. Options: =over 4 =item file File to return the contents of. =back =cut sub new { my ($class, %opts) = @_; if ($opts{file}) { die "not a file: $opts{file}" unless -f $opts{file}; } my $self = \%opts; bless $self, $class; return $self; } =head2 server( $new_server ) Get or set the server. =cut sub server { my $self = shift; my $server = shift; $self->{server} = $server if $server; return $self->{server}; } =head2 username( $new_username ) Get or set the username. =cut sub username { my $self = shift; my $username = shift; $self->{username} = $username if $username; return $self->{username}; } =head2 password( $new_password ) Get or set the password. =cut sub password { my $self = shift; my $password = shift; $self->{password} = $password if $password; return $self->{password}; } =head2 workspace( $new_workspace ) Get or set the workspace. =cut sub workspace { my $self = shift; my $workspace = shift; $self->{workspace} = $workspace if $workspace; return $self->{workspace}; } =head2 get_page( $page_name ) Returns the content of the specified file or the page stored locally in the object. =cut sub get_page { my $self = shift; my $page_name = shift; if ($self->{file}) { warn "Mock rester: returning content of $self->{file} for page ($page_name)\n"; open(my $fh, $self->{file}) or die "Can't open $self->{file}: $!"; local $/; my $page = <$fh>; close $fh; return $page; } my $text = shift @{ $self->{page}{$page_name} }; unless (defined $text) { $text = "$page_name not found"; } return $text; } =head2 get_pages Retrieve a list of pages in the current workspace. =cut sub get_pages { my ($self) = @_; return $self->{_get_pages} if $self->{_get_pages}; # testing shortcut return keys %{ $self->{page} }; } =head2 put_page( $page_name ) Stores the page content in the object. =cut sub put_page { my ($self, $page, $content) = @_; die delete $self->{die_on_put} if $self->{die_on_put}; push @{ $self->{page}{$page} }, $content; } =head2 put_pagetag( $page, $tag ) Stores the page tags in the object. =cut sub put_pagetag { my ($self, $page, $tag) = @_; push @{$self->{page_tags}{$page}}, $tag; } =head2 get_pagetags( $page ) Retrieves page tags stored in the object. =cut sub get_pagetags { my ($self, $page) = @_; my $tags = $self->{page_tags}{$page} || []; return @$tags if wantarray; return join ' ', @$tags; } =head2 die_on_put( $rc ) Tells the next put_page() to die with the supplied return code. =cut sub die_on_put { my $self = shift; my $rc = shift; $self->{die_on_put} = $rc; } =head2 accept( $mime_type ) Stores the requested mime type. =cut sub accept { my $self = shift; $self->{accept} = shift; } =head2 order( $order ) Stores the requested order. =cut sub order { my $self = shift; $self->{order} = shift; } =head2 get_taggedpages( $tag ) Retrieves the taggedpages stored in the object. =cut sub get_taggedpages { my $self = shift; my $tag = shift; # makes testing easier my $mock_return = $self->{taggedpages}{$tag}; return $mock_return if defined $mock_return; my @taggedpages; for my $page (keys %{$self->{page_tags}}) { my $tags = $self->{page_tags}{$page}; next unless grep { $_ eq $tag } @$tags; push @taggedpages, $page; } return @taggedpages if wantarray; return join ' ', @taggedpages; } =head2 set_taggedpages( $tag, $return ) Store the taggedpages return value in the object. This is not a real function, but it can make testing easier. =cut sub set_taggedpages { my $self = shift; my $tag = shift; $self->{taggedpages}{$tag} = shift; } =head2 json_verbose Set the json_verbose flag. =cut sub json_verbose { $_[0]->{json_verbose} = $_[1] } =head2 response Retrieve a fake response object. =cut sub response { my $self = shift; $self->{response} = shift if @_; $self->{response} ||= HTTP::Response->new(200); return $self->{response}; } =head1 AUTHOR Luke Closs, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2006 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/Resting/LocalCopy.pm0000644000374100037410000000674311131746306024015 0ustar lukeclukecpackage Socialtext::Resting::LocalCopy; use strict; use warnings; use JSON::XS; =head1 NAME Socialtext::Resting::LocalCopy - Maintain a copy on disk of a workspace =head1 SYNOPSIS Socialtext::Resting::LocalCopy allows one to copy a workspace into files on the local disk, and to update a workspace from files on disk. =cut our $VERSION = '0.01'; =head1 METHODS =head2 new Create a new LocalCopy object. Requires a C parameter, which should be a Socialtext::Rester-like object. =cut sub new { my $class = shift; my $self = { @_ }; die 'rester is mandatory' unless $self->{rester}; bless $self, $class; return $self; } =head2 pull Reads a workspace and pulls all of the pages into files in the specified directory. Options are passed in as a list of named options: =over 4 =item dir - The directory the files should be saved to. =item tag - an optional tag. If specified, only tagged files will be pulled. =back =cut sub pull { my $self = shift; my %opts = @_; my $dir = $opts{dir}; my $tag = $opts{tag}; my $r = $self->{rester}; $r->accept('text/plain'); my @pages = $tag ? $r->get_taggedpages($tag) : $r->get_pages(); $r->accept('application/json'); $r->json_verbose(1); for my $p (@pages) { print "Saving $p ...\n"; my $obj = decode_json($r->get_page($p)); # Trim the content my %to_keep = map { $_ => 1 } $self->_keys_to_keep; for my $k (keys %$obj) { delete $obj->{$k} unless $to_keep{$k}; } my $wikitext_file = "$dir/$obj->{page_id}"; open(my $fh, ">$wikitext_file") or die "Can't open $wikitext_file: $!"; binmode $fh, ':utf8'; print $fh delete $obj->{wikitext}; close $fh or die "Can't write $wikitext_file: $!"; my $json_file = "$wikitext_file.json"; open(my $jfh, ">$json_file") or die "Can't open $json_file: $!"; print $jfh encode_json($obj); close $jfh or die "Can't write $json_file: $!"; } } sub _keys_to_keep { qw/page_id name wikitext tags/ } =head2 push Reads a directory and pushes all the files in that directory up to the specified workspace. Options are passed in as a list of named options: =over 4 =item dir - The directory the files should be saved to. =item tag - an optional tag. If specified, only tagged files will be pushed. Note - tag is not yet implemented. =back =cut sub push { my $self = shift; my %opts = @_; my $dir = $opts{dir}; my $tag = $opts{tag}; my $r = $self->{rester}; die "Sorry - push by tag is not yet implemented!" if $tag; my @files = glob("$dir/*.json"); for my $f (@files) { open(my $fh, $f) or die "Can't open $f: $!"; local $/ = undef; my $obj = decode_json(<$fh>); close $fh; (my $wikitext_file = $f) =~ s/\.json$//; open(my $wtfh, $wikitext_file) or die "Can't open $wikitext_file: $!"; $obj->{wikitext} = <$wtfh>; close $wtfh; print "Putting $obj->{page_id} ...\n"; $r->put_page($obj->{name}, $obj->{wikitext}); $r->put_pagetag($obj->{name}, $_) for @{ $obj->{tags} }; } } =head1 BUGS Attachments are not yet supported. Push by tag is not yet supported. =head1 AUTHOR Luke Closs, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2007 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/Resting/Getopt.pm0000644000374100037410000000330711314207132023353 0ustar lukeclukecpackage Socialtext::Resting::Getopt; use strict; use warnings; use base 'Exporter'; use Socialtext::Resting::DefaultRester; use Getopt::Long qw/:config/; our @EXPORT_OK = qw/get_rester rester_usage/; =head1 NAME Socialtext::Resting::Getopt - Handle command line rester args =head1 SYNOPSIS use Socialtext::Resting::Getopt qw/get_rester/; my $rester = get_rester(); =cut our $VERSION = '0.01'; =head1 FUNCTIONS =head2 get_rester Create a new rester from command line args. =cut sub get_rester { my %opts = @_; Getopt::Long::Configure('pass_through'); GetOptions( \%opts, 'server|s=s', 'workspace|w=s', 'username|u=s', 'password|p=s', 'user_cookie=s', 'rester-config|c=s', ); Getopt::Long::Configure('no_pass_through'); return Socialtext::Resting::DefaultRester->new(%opts); } =head2 rester_usage Return usage text for the arguments accepted by this module. =cut sub rester_usage { my $rc_file = $Socialtext::Resting::DefaultRester::CONFIG_FILE; return < >> =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/Resting/Utils.pm0000644000374100037410000000077711323242024023220 0ustar lukeclukecpackage Socialtext::Resting::Utils; use strict; use warnings; =head1 NAME Socialtext::Resting::Utils - Utilities for Socialtext REST APIs =cut our $VERSION = '0.21'; =head1 SYNOPSIS Socialtext::Resting::Utils does not contain any code. =head1 AUTHOR Luke Closs, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2006, 2007 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/Resting/TaggedPages.pm0000644000374100037410000000272311131746306024275 0ustar lukeclukecpackage Socialtext::Resting::TaggedPages; use strict; use warnings; use base 'Exporter'; our @EXPORT_OK = qw/tagged_pages/; =head1 NAME Socialtext::Resting::TaggedPages - Utilities for finding pages with tags =head1 SYNOPSIS use Socialtext::Resting::TaggedPages qw/tagged_pages/; my $untagged_pages = tagged_pages( rester => $r, notags => 1 ); my $foo_pages = tagged_pages( rester => $r, tags => ['foo'] ); =cut our $VERSION = '0.01'; =head1 FUNCTIONS =head2 tagged_pages Return a list of tagged pages. See SYNOPSIS for usage. =cut sub tagged_pages { my %opts = ( tags => [], notags => undef, @_, ); my $r = $opts{rester} or die "Rester is mandatory"; $r->accept('perl_hash'); my $all_pages = $r->get_pages; my @pages; for my $p (@$all_pages) { my $pagetags = $p->{tags} || []; if ($opts{notags}) { next if @$pagetags; push @pages, $p->{page_id}; } else { my $missing_tag = 0; for my $t (@{ $opts{tags} }) { unless (grep { $_ eq $t } @$pagetags) { $missing_tag++; } } push @pages, $p->{page_id} unless $missing_tag; } } return \@pages; } =head1 AUTHOR Luke Closs, C<< >> =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/WikiObject.pm0000644000374100037410000001746111314207132022536 0ustar lukeclukecpackage Socialtext::WikiObject; use strict; use warnings; use Carp; use Data::Dumper; =head1 NAME Socialtext::WikiObject - Represent wiki markup as a data structure and object =cut our $VERSION = '0.03'; =head1 SYNOPSIS use Socialtext::WikiObject; my $page = Socialtext::WikiObject->new( rester => $Socialtext_Rester, page => $wiki_page_name, ); =head1 DESCRIPTION Socialtext::WikiObject is a package that attempts to fetch and parse some wiki text into a perl data structure. This makes it easier for tools to access information stored on the wiki. The goal of Socialtext::WikiObject is to create a structure that is 'good enough' for most cases. The wiki data is parsed into a data structure intended for easy access to the data. Headings, lists and text are supported. Simple tables without multi-line rows are parsed. Subclass Socialtext::WikiObject to create a custom module for your data. You can provide accessors into the parsed wiki data. Subclasses can simply provide accessors into the data they wish to expose. =head1 FUNCTIONS =head2 new( %opts ) Create a new wiki object. Options: =over 4 =item rester Users must provide a Socialtext::Resting object setup to use the desired workspace and server. =item page If the page is given, it will be loaded immediately. =back =cut our $DEBUG = 0; sub new { my ($class, %opts) = @_; croak "rester is mandatory!" unless $opts{rester}; my $self = { %opts }; bless $self, $class; $self->load_page if $self->{page}; return $self; } =head2 load_page( $page_name ) Load the specified page. Will fetch the wiki page and parse it into a perl data structure. =cut sub load_page { my $self = shift; my $page = $self->{page} = shift || $self->{page}; croak "Must supply a page to load!" unless $page; my $rester = $self->{rester}; my $wikitext = $rester->get_page($page); return unless $wikitext; $self->parse_wikitext($wikitext); } =head2 parse_wikitext( $wikitext ) Parse the wikitext into a data structure. =cut sub parse_wikitext { my $self = shift; my $wikitext = shift; $self->_find_smallest_heading($wikitext); $self->{parent_stack} = []; $self->{base_obj} = $self; for my $line (split "\n", $wikitext) { # whitespace if ($line =~ /^\s*$/) { $self->_add_whitespace; } # Header line elsif ($line =~ m/^(\^\^*)\s+(.+?):?\s*$/) { $self->_add_heading($1, $2); } # Lists elsif ($line =~ m/^[#\*]\s+(.+)/) { $self->_add_list_item($1); } # Tables elsif ($line =~ m/^\|\s*(.+?)\s*\|$/) { $self->_add_table_row($1); } else { $self->_add_text($line); } } $self->_finish_parse; warn Dumper $self if $DEBUG; } sub _add_whitespace {} sub _finish_parse { my $self = shift; delete $self->{current_heading}; delete $self->{base_obj}; delete $self->{heading_level_start}; delete $self->{parent_stack}; } sub _add_heading { my $self = shift; my $heading_level = length(shift || '') - $self->{heading_level_start}; my $new_heading = shift; warn "hl=$heading_level hls=$self->{heading_level_start} ($new_heading)\n" if $DEBUG; push @{$self->{headings}}, $new_heading; my $cur_heading = $self->{current_heading}; while (@{$self->{parent_stack}} > $heading_level) { warn "going down" if $DEBUG; # Down a header level pop @{$self->{parent_stack}}; } if ($heading_level > @{$self->{parent_stack}}) { if ($cur_heading) { warn "going up $cur_heading ($new_heading)" if $DEBUG; # Down a header level # Up a level - create a new node push @{$self->{parent_stack}}, $cur_heading; my $old_obj = $self->{base_obj}; $self->{base_obj} = { name => $cur_heading }; $self->{base_obj}{text} = $old_obj->{$cur_heading} if $cur_heading and $old_obj->{$cur_heading}; # update previous base' - @items and direct pointers push @{ $old_obj->{items} }, $self->{base_obj}; $old_obj->{$cur_heading} = $self->{base_obj}; $old_obj->{lc($cur_heading)} = $self->{base_obj}; } else { warn "Going up, no previous heading ($new_heading)\n" if $DEBUG; } } else { warn "Something... ($new_heading)\n" if $DEBUG; warn "ch=$cur_heading\n" if $DEBUG and $cur_heading; $self->{base_obj} = $self; for (@{$self->{parent_stack}}) { $self->{base_obj} = $self->{base_obj}{$_} || die "Can't find $_"; } } $self->{current_heading} = $new_heading; warn "Current heading: $self->{current_heading}\n" if $DEBUG; } sub _add_text { my $self = shift; my $line = shift; # Text under a heading my $cur_heading = $self->{current_heading}; if ($cur_heading) { if (ref($self->{base_obj}{$cur_heading}) eq 'ARRAY') { $self->{base_obj}{$cur_heading} = { items => $self->{base_obj}{$cur_heading}, text => "$line\n", } } elsif (ref($self->{base_obj}{$cur_heading}) eq 'HASH') { $self->{base_obj}{$cur_heading}{text} .= "$line\n"; } else { $self->{base_obj}{$cur_heading} .= "$line\n"; } $self->{base_obj}{lc($cur_heading)} = $self->{base_obj}{$cur_heading}; } # Text without a heading else { $self->{base_obj}{text} .= "$line\n"; } } sub _add_list_item { my $self = shift; my $item = shift; $self->_add_array_field('items', $item); } sub _add_table_row { my $self = shift; my $line = shift; my @cols = split /\s*\|\s*/, $line; $self->_add_array_field('table', \@cols); } sub _add_array_field { my $self = shift; my $field_name = shift; my $item = shift; my $field = $self->{current_heading} || $field_name; my $bobj = $self->{base_obj}; if (! exists $bobj->{$field} or ref($bobj->{$field}) eq 'ARRAY') { push @{$bobj->{$field}}, $item; } elsif (ref($bobj->{$field}) eq 'HASH') { push @{$bobj->{$field}{$field_name}}, $item; } else { my $text = $bobj->{$field}; $bobj->{$field} = { text => $text, $field_name => [ $item ], }; } $bobj->{lc($field)} = $bobj->{$field}; } sub _find_smallest_heading { my $self = shift; my $text = shift; my $big = 99; my $heading = $big; while ($text =~ m/^(\^+)\s/mg) { my $len = length($1); $heading = $len if $len < $heading; } $self->{heading_level_start} = $heading == $big ? 1 : $heading; } =head1 AUTHOR Luke Closs, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Socialtext::EditPage You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2006 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/lib/Socialtext/EditPage.pm0000644000374100037410000002550711267165625022207 0ustar lukeclukecpackage Socialtext::EditPage; use warnings; use strict; use Carp qw/croak/; use File::Temp; use Socialtext::Resting::DefaultRester; use Socialtext::Resting; use JSON::XS; =head1 NAME Socialtext::EditPage - Edit a wiki page using your favourite EDITOR. =cut our $VERSION = '0.04'; =head1 SYNOPSIS Fetch a page, edit it, and then post it. use Socialtext::EditPage; # The rester is set with the server and workspace my $rester = Socialtext::Resting->new(%opts); my $s = Socialtext::EditPage->new(rester => $rester); $s->edit_page('Snakes on a Plane'); =head1 FUNCTIONS =head2 new( %opts ) Arguments: =over 4 =item rester Users must provide a Socialtext::Resting object setup to use the desired workspace and server. =item pull_includes If true, C wafls will be inlined into the page as extraclude blocks. =back =cut sub new { my ($class, %opts) = @_; $opts{rester} ||= Socialtext::Resting::DefaultRester->new(%opts); my $self = { %opts }; bless $self, $class; return $self; } =head2 C This method will fetch the page content, and then run $EDITOR on the file. After the file has been edited, it will be put back on the wiki server. Arguments: =over 4 =item page The name of the page you wish to edit. =item callback If supplied, callback will be called after the page has been edited. This function will be passed the edited content, and should return the content to be put onto the server. =item summary_callback If supplied, callback will be called after the page has been edit. This function should return the edit summary text for this edit, if desired. =item tags If supplied, these tags will be applied to the page after it is updated. =item output If supplied, the page will be saved to the given file instead of edited. The page will not be uploaded to the server. =item template If specified, this page will be used as the template for a new page. =back =cut sub edit_page { my $self = shift; my %args = @_; my $page = $self->{page} = delete $args{page}; croak "page is mandatory" unless $page; my $rester = $self->{rester}; my $content = $self->_get_page($page); my $tags = delete $args{tags} || []; if ($args{template}) { if ($rester->response->code eq '404') { $content = $self->_get_page($args{template}); } else { print "Not using template '$args{template}' - page already " . "exists.\n"; } $rester->accept('text/plain'); my @tmpl_tags = grep { !/^template$/ } $rester->get_pagetags($args{template}); push @$tags, @tmpl_tags; } if ($args{output}) { _write_file($args{output}, $content); print "Wrote $page content to $args{output}\n"; return; } my $orig_content = $content; my $edit_summary; while (1) { my $new_content = $content; $new_content = $self->_pre_process_special_wafls($new_content); $new_content = $self->_edit_content($new_content); if ($orig_content eq $new_content) { print "$page did not change.\n"; return; } $new_content = $args{callback}->($new_content) if $args{callback}; $new_content = $self->_process_special_wafls($new_content); $edit_summary ||= $args{summary_callback}->() if $args{summary_callback}; eval { $page =~ s#/#-#g; # cannot have /'s in the page name $rester->put_page($page, { content => $new_content, date => scalar(gmtime), ($edit_summary ? (edit_summary => $edit_summary) : ()), } ); }; last unless $@; if ($@ =~ /412/) { # collision detected! print "A collision was detected. I will merge the changes and " . "re-open your editor.\nHit enter.\n"; sleep 2; print "Merging...\n"; $orig_content = $self->_get_page($page); my $updated_file = _write_file(undef, $orig_content); my $orig_file = _write_file(undef, $content); my $our_file = _write_file(undef, $new_content); # merge the content and re-edit # XXX: STDERR is not redirected. Should use IPC::Run. However, # it's nice to be able to create pages w/ quotes and other shell # characters in their name. system(qw(merge -L yours -L original -L), "new edit", $our_file, $orig_file, $updated_file); $content = _read_file($our_file); } else { $self->_handle_error($@, $page, $new_content); } } if ($tags) { $tags = [$tags] unless ref($tags) eq 'ARRAY'; for my $tag (@$tags) { print "Putting page tag $tag on $page\n"; $rester->put_pagetag($page, $tag); } } print "Updated page $page\n"; } =head2 C This method will retrieve a last of all pages tagged with the supplied tag, and then open the latest one for edit. Arguments are passed through to edit_page(), accept for: =over 4 =item tag The name of the tag you wish to edit. =back =cut sub edit_last_page { my $self = shift; my %opts = @_; my $tag = delete $opts{tag} || croak "tag is mandatory"; my $rester = $self->{rester}; $rester->accept('application/json'); my $pages = decode_json($rester->get_taggedpages($tag)); unless (@$pages) { die "No pages found tagged '$tag'\n"; } my @pages = sort { $b->{modified_time} <=> $a->{modified_time} } @$pages; my $newest_page = shift @pages; print "Editing '$newest_page->{name}'\n"; $self->edit_page(page => $newest_page->{page_id}, %opts); } sub _get_page { my $self = shift; my $page_name = shift; my $rester = $self->{rester}; $rester->accept('text/x.socialtext-wiki'); my $page = $rester->get_page($page_name); if ($self->{pull_includes}) { while ($page =~ m/({include:?\s+\[([^\]]+)\]\s*}\n)/smg) { my $included_page = $2; my ($match_start, $match_size) = ($-[0], $+[0] - $-[0]); print "Pulling include in [$page_name] - [$included_page]\n"; my $pulled_content = $self->_get_page($included_page); chomp $pulled_content; my $included_content = ".pulled-extraclude [$included_page]\n" . "$pulled_content\n" . ".pulled-extraclude\n"; substr($page, $match_start, $match_size) = $included_content; } } return $page; } sub _edit_content { my $self = shift; my $content = shift; my $workspace = $self->{rester}->workspace || ''; (my $page = $self->{page}) =~ s#/#_#g; my $filename = File::Temp->new( TEMPLATE => "$workspace.$page.XXXX", SUFFIX => '.wiki' ); _write_file($filename, $content); my $editor = $ENV{EDITOR} || '/usr/bin/vim'; system( $editor, $filename ); return _read_file($filename); } { my @special_wafls = ( [ '.extraclude' => '.e-x-t-r-a-c-l-u-d-e' ], [ '.pulled-extraclude' => '.extraclude', 'pre-only' ], ); sub _pre_process_special_wafls { my $self = shift; my $text = shift; # Escape special wafls for my $w (@special_wafls) { my $wafl = $w->[0]; my $expanded = $w->[1]; $text =~ s/\Q$wafl\E\b/$expanded/g; } return $text; } sub _process_special_wafls { my $self = shift; my $text = shift; my $rester = $self->{rester}; my $included_content = sub { my $type = lc shift; my $name = shift; my $newline = shift || ''; if ($type eq 'clude') { return "{include: [$name]}\n"; } elsif ($type eq 'link') { return "[$name]$newline"; } die "Unknown extrathing: $type"; }; while ($text =~ s/\.extra(clude|link)\s # $1 is title \[([^\]]+)\] # $2 is [name] (\n?) # $3 is extra newline (.+?) \.extra(?:clude|link)\n /$included_content->($1, $2, $3)/ismex) { my ($page, $new_content) = ($2, $4); print "Putting extraclude '$page'\n"; eval { $rester->put_page($page, $new_content); }; $self->_handle_error($@, $page, $new_content) if $@; } # Unescape special wafls for my $w (@special_wafls) { next if $w->[2]; my $wafl = $w->[0]; my $expanded = $w->[1]; $text =~ s/\Q$expanded\E\b/$wafl/ig; } return $text; } } sub _handle_error { my ($self, $err, $page, $content) = @_; my $file = Socialtext::Resting::_name_to_id($page) . ".sav"; my $i = 0; while (-f $file) { $i++; $file =~ s/\.sav(?:\.\d+)?$/\.sav\.$i/; } warn "Failed to write '$page', saving to $file\n"; _write_file($file, $content); die "$err\n"; } sub _write_file { my ($filename, $content) = @_; $filename ||= File::Temp->new( SUFFIX => '.wiki' ); open(my $fh, ">$filename") or die "Can't open $filename: $!"; print $fh $content || ''; close $fh or die "Can't write $filename: $!"; return $filename; } sub _read_file { my $filename = shift; open(my $fh, $filename) or die "unable to open $filename $!\n"; my $new_content; { local $/; $new_content = <$fh>; } close $fh; return $new_content; } =head1 AUTHOR Luke Closs, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Socialtext::EditPage You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2006 Luke Closs, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Socialtext-Resting-Utils-0.21/Changes0000644000374100037410000001062611323242007016550 0ustar lukeclukecRevision history for Socialtext-Utils 0.21 - Tue Jan 12 19:54:04 PST 2010 - Add dependency on Crypt::DES 0.20 - Tue Apr 21 13:46:23 PDT 2009 - Add ability to use an NLW-user cookie instead of user/pass. - Bugfixes to better work with and without Crypt::CBC 0.19 - Mon Apr 20 11:22:58 PDT 2009 - s/localtime/gmtime/ when posting pages 0.18 - Fri Apr 17 15:44:03 PDT 2009 - Added stu-tagged-pages utility - stu-most-wanted won't update the page if it didn't change. - Added order() to the mock rester - create a default ~/.wikeditrc if it doesn't exist - stu-local-copy accepts multiple tags - have DefaultRester use CBC::Crypt (if available) to crypt up the password - add an edit summary callback method to Socialtext::EditPage 0.17 - Tue Oct 9 10:03:23 PDT 2007 - added extralink wafl - improved/tweaked stu-most-wanted output to link to non-existent pages - added stu-local-copy tool for moving content between a workspace and local disk - made it so that a $pagename.sav file is always written to before the code dies --kevinj - don't add the tag template to pages when creating them from an actual template --kevinj - limited stu-most-wanted to only show the first 100 most wanted pages 0.16 - Wed Aug 8 14:37:47 PDT 2007 - fixed bug when PUTting pages with a '/' in the name - Added a WikiObject to return a .pre block on a page - refactored YAML WikiObject to use PreBlock package - Added a WikiObject for parsing two column tables into a hash - removed Socialtext::EditBlog 0.15 - Thu Jun 21 15:40:45 PDT 2007 - fixed typo in .wikeditrc docs 0.14 - Thu May 31 10:24:37 PDT 2007 - Added --tag to wikedit - fixed bug when editing pages that have a '/' - Updated MANIFEST, so stu-most-wanted is actually packaged :) 0.13 - Thu May 24 12:39:46 PDT 2007 - Add stu-most-wanted which produces 'Most Wanted Pages' page - Socialtext::Resting::Getopt doesn't set pass_through globally - Socialtext::EditPage names the tempfiles more meaningfully - Added a .wiki extension to the tempfiles. - Made system() calls in EditPage take LIST form, rather than STRING. - added get_pages() to the mock rester 0.12 - Wed Mar 21 21:40:29 PDT 2007 - Refactor Socialtext::Resting::Mock's tag and page handling - It's now more like an in-memory Socialtext::Rester - Added a primative Socialtext::EditBlog - Add stu-save-pages - Use /usr/bin/vim if no $EDITOR 0.11 - Sun Feb 25 10:54:55 PST 2007 - YAML wiki object only looks for yaml in the first .pre block - Use Test::Mock::HTTP::Response in Socialtext::Rester::Mock 0.10 - Tue Feb 20 10:46:05 PST 2007 - Copy tags from template pages when they're used - Add Socialtext::Resting::Getopt to handle command line args - Fix Mock Rester to match real library's get_pagetags() - Added Socialtext::WikiObject::YAML class - Added Socialtext::WikiObject::Factory which reads magic tags to find the class to create the WikiObject as. 0.09 - Wed Feb 14 17:03:59 PST 2007 - Fixed t/wikedit.t when a ~/.wikeditrc isn't there 0.08 - Sun Feb 11 11:18:28 PST 2007 - Add edit_last_page(), which opens the most recently edited page tagged with the given tag. - Add --template switch to edit new pages from a template - Add response() method to mock rester 0.07 - Thu Jan 25 11:20:12 PST 2007 - Include DefaultRester.pm in the MANIFEST and a unit test - bump version dependencies 0.06 - Tue Jan 23 21:05:35 PST 2007 - Added --pull-includes feature - Added extraclude support - Added collision detection when PUTting edits - all unit tests now use Socialtext::Resting::Mock - Added --output option to wikedit - Introduced Socialtext::Resting::DefaultRester class to handle storing user/pass/server/workspace info in one place 0.05 - Tue Jan 9 17:31:52 PST 2007 - fixed typo in usage 0.04 - Tue Jan 9 15:58:50 PST 2007 - Added Socialtext::Resting::Mock for faking the interface by reading from a file - wikedit now uses .wiki extension for temp files 0.03 - Fri Dec 29 17:10:18 PST 2006 - added simple table support - refactored code 0.02 - Sat Dec 9 21:25:05 PST 2006 - Removed dependency on Test::Exception - Fixed infinite loop when a smaller heading (^^^^) is seen before a bigger heading (^^) - Fixed handling of mixed list/text in a section 0.01 - Sat Dec 2 19:49:17 PST 2006 - wikedit - Edit a wiki page with $EDITOR - Socaltext::EditPage - added callback for further munging - added tag list Socialtext-Resting-Utils-0.21/MANIFEST0000644000374100037410000000160611172203217016406 0ustar lukeclukecbin/wikedit bin/stu-local-copy bin/stu-most-wanted bin/stu-save-pages bin/stu-tagged-pages Changes lib/Socialtext/EditPage.pm lib/Socialtext/WikiObject.pm lib/Socialtext/WikiObject/YAML.pm lib/Socialtext/WikiObject/PreBlock.pm lib/Socialtext/WikiObject/TableConfig.pm lib/Socialtext/WikiObject/Factory.pm lib/Socialtext/Resting/DefaultRester.pm lib/Socialtext/Resting/Utils.pm lib/Socialtext/Resting/Mock.pm lib/Socialtext/Resting/Getopt.pm lib/Socialtext/Resting/LocalCopy.pm lib/Socialtext/Resting/TaggedPages.pm Makefile.PL MANIFEST README t/00-load.t t/default-rester.t t/edit-page.t t/extraclude.txt t/extralink.txt t/mock-editor.pl t/object.t t/pod-coverage.t t/pod.t t/wikedit.t t/getopt.t t/factory.t t/yaml-object.t t/rester.conf t/getopt-test.pl t/pre-block.t t/table-config.t t/tagged-pages.t t/wiki-localcopy.t META.yml Module meta-data (added by MakeMaker) Socialtext-Resting-Utils-0.21/bin/0000755000374100037410000000000011323242063016022 5ustar lukeclukecSocialtext-Resting-Utils-0.21/bin/stu-local-copy0000755000374100037410000000224111131746306020630 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Socialtext::Resting::Getopt qw/get_rester/; use Socialtext::Resting::LocalCopy; use Getopt::Long; sub usage { my $msg = shift || ''; die <] [--from ] [--tag ] Saves wiki content to a local directory, or from a local directory. Either --to or --from must be specified. --tag specifies a tag to push/pull. EOT } my $r = get_rester(); my ($to, $from, @tags); GetOptions( 'to=s' => \$to, 'from=s' => \$from, 'tag=s' => \@tags, ) or usage; usage unless $to or $from; usage("$to is not a directory!\n") if $to and !-d $to; usage("$from is not a directory!\n") if $from and !-d $from; # if no tags are supplied, we still want to push/pull changes. push @tags, undef unless @tags; my $lc = Socialtext::Resting::LocalCopy->new( rester => $r ); if ($to) { print "Pulling content from " . $r->workspace . " into $to\n"; for my $tag (@tags) { $lc->pull(dir => $to, tag => $tag); } } else { print "Pushing content from $from into " . $r->workspace . "\n"; for my $tag (@tags) { $lc->push(dir => $from, tag => $tag); } } Socialtext-Resting-Utils-0.21/bin/wikedit0000755000374100037410000000212011131746306017411 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Socialtext::EditPage; use Socialtext::Resting::Getopt qw/get_rester rester_usage/; use Getopt::Long; my %opts = ( rester => get_rester() ); my %edit_opts = (tags => []); GetOptions( 'pull-includes'=> \$opts{pull_includes}, 'latest-tag=s' => \$opts{latest_tag}, 'o|output=s' => \$edit_opts{output}, 'template=s' => \$edit_opts{template}, 'tag=s@' => \$edit_opts{tags}, ) or usage(); my $page = shift; my $edit = Socialtext::EditPage->new(%opts); if ($page) { $edit->edit_page( page => $page, %edit_opts ); } elsif ($opts{latest_tag}) { $edit->edit_last_page( tag => $opts{latest_tag}, %edit_opts ); } else { usage(); } exit; sub usage { my $rester_usage = rester_usage(); die < --template=foo Uses content from page 'foo' as a template for new pages. $rester_usage EOT } Socialtext-Resting-Utils-0.21/bin/stu-save-pages0000644000374100037410000000105211131746306020615 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Socialtext::Resting; use Socialtext::Resting::Getopt qw/get_rester/; my $r = get_rester(); my @pages = $r->get_pages; unless (@pages) { die "No pages in workspace " . $r->workspace . "\n"; } print "Saving " . scalar(@pages) . " pages ...\n"; for my $p (@pages) { print "Saving '$p' ...\n"; my $filename = Socialtext::Resting::_name_to_id($p); open(my $fh, ">$filename") or die "Can't open $filename: $!"; print $fh $r->get_page($p); close $fh or die "Can't write $filename: $!"; } Socialtext-Resting-Utils-0.21/bin/stu-most-wanted0000644000374100037410000000361011131746306021026 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Socialtext::Resting::Getopt qw/get_rester/; my $r = get_rester(); my $most_wanted_page = 'Most Wanted Pages'; warn "Fetching all pages...\n"; my @all_pages = $r->get_pages(); my %most_wanted; my %wanters; for my $page (@all_pages) { next if $page eq $most_wanted_page; warn "Fetching '$page'\n"; my @incipient = $r->get_frontlinks($page, 1); for my $i (@incipient) { $wanters{$page}++; push @{ $most_wanted{$i} }, $page; } } warn "Creating most wanted page...\n"; my $incipient_page_count = keys %most_wanted; my $now = localtime; my $page_wanters_count = keys %wanters; my $new_page = "^^ Most Wanted Pages in " . $r->workspace . " at $now.\n" . "There are $incipient_page_count pages wanted by $page_wanters_count other pages.\n" . "This page is autogenerated by `stu-most-wanted`, from \"Socialtext-Resting-Utils\" " . "\n\n" . "| *Wanted Page* | *Count* | *Wanters* |\n"; my $max_most_wanted = 100; for my $i ( sort { @{ $most_wanted{$b} } <=> @{ $most_wanted{$a} } } keys %most_wanted ) { $new_page .= "| [$i] | " . @{ $most_wanted{$i} } . " | " . join(", ", map { "{{[$_]}}" } @{ $most_wanted{$i} }) . " |\n"; $max_most_wanted--; last if $max_most_wanted == 0; } # Check if the page has changed my $page_name = 'Most Wanted Pages'; my $prev_page = strip_date_from_page($r->get_page($page_name)); my $new_page_dateless = strip_date_from_page($new_page); if ($prev_page ne $new_page_dateless) { warn "Putting most wanted pages page...\n"; $r->put_page($page_name, $new_page); } else { warn "Most wanted didn't change...\n"; } exit; sub strip_date_from_page { my $content = shift; $content =~ s/Most Wanted Pages in \S+ at [^.]+.//; return $content; } Socialtext-Resting-Utils-0.21/bin/stu-tagged-pages0000755000374100037410000000117111131746306021117 0ustar lukeclukec#!/usr/bin/perl use strict; use warnings; use Socialtext::Resting::Getopt qw/get_rester/; use Socialtext::Resting::TaggedPages qw/tagged_pages/; use Getopt::Long; sub usage { die < ...] Return a list of pages with the specified tag(s). --notags shows pages with no tags EOT } my $r = get_rester(); my @tags; my $no_tags; GetOptions( 'tag=s' => \@tags, 'notags' => \$no_tags, ) or usage; usage unless @tags or $no_tags; my $tagged_pages = tagged_pages( rester => $r, tags => \@tags, notags => $no_tags, ); print join "\n", @$tagged_pages; exit; Socialtext-Resting-Utils-0.21/META.yml0000644000374100037410000000141111323242063016520 0ustar lukeclukec--- #YAML:1.0 name: Socialtext-Resting-Utils version: 0.21 abstract: Utilities for Socialtext REST APIs author: - Luke Closs license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Crypt::CBC: 0 Crypt::DES: 0 Getopt::Long: 2.36 JSON::XS: 2.01 Socialtext::Resting: 0.27 Test::Mock::LWP: 0 Test::More: 0 YAML: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.50 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Socialtext-Resting-Utils-0.21/Makefile.PL0000644000374100037410000000175111323241506017231 0ustar lukeclukecuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Socialtext::Resting::Utils', AUTHOR => 'Luke Closs ', VERSION_FROM => 'lib/Socialtext/Resting/Utils.pm', ABSTRACT_FROM => 'lib/Socialtext/Resting/Utils.pm', PL_FILES => {}, PREREQ_PM => { 'Socialtext::Resting' => '0.27', 'Test::More' => 0, 'Test::Mock::LWP' => 0, 'Getopt::Long' => '2.36', 'JSON::XS' => '2.01', 'YAML' => 0, 'Crypt::CBC' => 0, 'Crypt::DES' => 0, }, EXE_FILES => [ 'bin/wikedit', 'bin/stu-save-pages', 'bin/stu-most-wanted', 'bin/stu-local-copy', 'bin/stu-tagged-pages', ], dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Socialtext-Resting-Utils-*' }, ); Socialtext-Resting-Utils-0.21/README0000644000374100037410000000212211131746306016135 0ustar lukeclukecSocialtext::Resting::Utils Utility code for interacting with a Socialtext wiki using the Socialtext::Resting interface. Socialtext::EditPage - simple interface to edit a wiki page using $EDITOR wikedit - script to edit a Socialtext wiki page using $EDITOR INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Socialtext::EditPage You can also look for information at: Search CPAN http://search.cpan.org/dist/Socialtext-Resting-Utils CPAN Request Tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Socialtext-Resting-Utils AnnoCPAN, annotated CPAN documentation: http://annocpan.org/dist/Socialtext-Resting-Utils CPAN Ratings: http://cpanratings.perl.org/d/Socialtext-Resting-Utils COPYRIGHT AND LICENCE Copyright (C) 2006 Luke Closs This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.