package 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;