SourceForgeJP/Wiki.pm

   1 # WWW::SourceForge.JP::Wiki
   2 # by hylom
   3 # This code is under GPL.
   4 #
   5
   6 use LWP;
   7 use HTTP::Cookies;
   8 use HTTP::Request::Common;
   9 use HTML::Entities;
  10 use Encode;
  11 use utf8;
  12
  13 package WWW::SourceForgeJP::Wiki;
  14
  15 sub new {
  16     my $class = shift @_;
  17     my $sf = shift @_;
  18
  19     my $self = {
  20         'sf' => $sf,
  21         '_temp_page' => 'www-sfjp-wik-itemp',
  22     };
  23
  24     return bless $self, $class;
  25 }
  26
  27 sub _temp_page {
  28     my $self = shift @_;
  29     return $self->{_temp_page};
  30 }
  31
  32 sub sf {
  33     my $self = shift @_;
  34     return $self->{sf};
  35 }
  36
  37 sub _get_wikipage_url {
  38     my $self = shift @_;
  39     my $project = shift @_;
  40     my $page_name = shift @_;
  41
  42     return "http://sourceforge.jp/projects/$project/wiki/$page_name";
  43 }
  44
  45 sub get_page_list {
  46     my $self = shift @_;
  47     my $project = shift @_;
  48
  49     my $url = $self->_get_wikipage_url( $project, $self->_temp_page );
  50     $url .= '?action=update';
  51
  52     my $ua = $self->sf->lwp_ua;
  53     my $req_form = {
  54         'text' => '[[TitleIndex]]',
  55         'comment' => "",
  56         'do_preview' => '1',
  57     };
  58
  59     my $resp = $ua->post( $url, $req_form );
  60
  61     my $page_list_ref = [];
  62
  63     my $content_string = $resp->content;
  64     my $list_str = "";
  65     $content_string =~ s/\n//mg;
  66     $content_string =~ s/\r//mg;
  67     $content_string =~ s/^.*<div[^>]*class="wiki-content"[^>]*>//;
  68     if( $content_string =~ m/<ul>(.*?)<\/ul>/m ) {
  69         $list_str = $1;
  70         while( $list_str ) {
  71             if( $list_str =~ s/<li>(.*?)(<li>|<\/ul>|<\/li>)/$2/m ) {
  72                 my $item = $1;
  73                 my $page_name = "";
  74 #               print $1, " - ", $2, "\n";
  75                 if( $item =~ m/href=["'].*\/(.*?)["']/ ) {
  76                     $page_name = $1;
  77                     push @$page_list_ref, $page_name;
  78                 }
  79             } else {
  80                 last;
  81             }
  82         }
  83     }
  84
  85     return $page_list_ref;
  86 }
  87
  88
  89 sub get_raw_text {
  90     my $self = shift @_;
  91     my $project = shift @_;
  92     my $page_name = shift @_;
  93
  94     my $url = $self->_get_wikipage_url( $project, $page_name );
  95     $url .= '?action=edit';
  96
  97     my $ua = $self->sf->lwp_ua;
  98     my $resp = $ua->get( $url );
  99
 100     my $content = $resp->content;
 101
 102     $content =~ s/.*<textarea.*?id="text".*?>//s;
 103     if( $content =~ m/(.*)<\/textarea>/s ) {
 104         $content = $1;
 105     }
 106     $content = HTML::Entities::decode_entities($content);
 107     return Encode::decode_utf8($content);
 108
 109 }
 110
 111 sub edit_page {
 112     my $self = shift @_;
 113     my %args = @_;
 114
 115     my $project = $args{project};
 116     my $page_name = $args{page};
 117     my $text = $args{text};
 118
 119     my $title = "";
 120     if( $args{title} ) {
 121         $title = $args{title};
 122     }
 123     my $comment = "";
 124     if( $args{comment} ) {
 125         $comment = $args{comment};
 126     }
 127
 128 #  print "$project - $page_name - $text - $comment";
 129
 130     my $url = $self->_get_wikipage_url( $project, $page_name );
 131     $url .= '?action=update';
 132
 133     my $ua = $self->sf->lwp_ua;
 134     my $req_form = {
 135         'text' => $text,
 136         'comment' => $comment,
 137         'title' => $title,
 138         'commit' => '1',
 139     };
 140
 141     my $resp = $ua->post( $url, $req_form );
 142     if( $resp->is_error ) {
 143         return 0;
 144     } else {
 145         return 1;
 146     }
 147 }
 148
 149 # delete_page( project_name, page_name )
 150 sub delete_page {
 151     my $self = shift @_;
 152     my $project = shift @_;
 153     my $page_name = shift @_;
 154
 155     my $url = $self->_get_wikipage_url( $project, $page_name );
 156     $url = "$url?action=delete";
 157
 158     my $req_form = {
 159         'commit' => '1',
 160     };
 161
 162     my $ua = $self->sf->lwp_ua;
 163     my $resp = $ua->post( $url, $req_form );
 164
 165     if( $resp->is_error ) {
 166         return 0;
 167     } else {
 168         return 1;
 169     }
 170 }
 171
 172
 173 # post_attachment( <project_name>, <page_name>, <filename1>, <filename2>,... )
 174 sub post_attachment {
 175     my $self = shift @_;
 176     my %args = @_;
 177
 178     my $project = $args{project};
 179     my $page_name = $args{page};
 180     my $file_name = $args{file};
 181
 182
 183     my $url = $self->_get_wikipage_url( $project, $page_name );
 184     $url .= '/attach/!upload';
 185
 186     my $ua = $self->sf->lwp_ua;
 187
 188     my $req = HTTP::Request::Common::POST $url, Content_Type => 'form-data',
 189     Content => [ new_attach => ["$file_name"],
 190                  replace_file => "1",
 191                  commit => utf8::decode("アップロード"),
 192         ];
 193
 194     my $resp = $ua->request( $req );
 195
 196     if( $resp->is_error ) {
 197           print "error:", $resp->message, "\n";
 198         return 0; #print "upload $file_name: failed.\n";
 199     } else {
 200         return 1; #print "upload $file_name: succeed.\n";
 201     }
 202 }
 203
 204 1;