Menu
▾
▴
[Webfetch-commits] SF.net SVN: webfetch:[46] branches/v0.13/lib/WebFetch/Output/TWiki.pm
|
From: <ik...@us...> - 2009-09-05 09:35:44
|
Revision: 46
http://webfetch.svn.sourceforge.net/webfetch/?rev=46&view=rev
Author: ikluft
Date: 2009-09-05 09:35:33 +0000 (Sat, 05 Sep 2009)
Log Message:
-----------
new module WebFetch::Output::TWiki
Added Paths:
-----------
branches/v0.13/lib/WebFetch/Output/TWiki.pm
Added: branches/v0.13/lib/WebFetch/Output/TWiki.pm
===================================================================
--- branches/v0.13/lib/WebFetch/Output/TWiki.pm (rev 0)
+++ branches/v0.13/lib/WebFetch/Output/TWiki.pm 2009-09-05 09:35:33 UTC (rev 46)
@@ -0,0 +1,414 @@
+#
+# WebFetch::Output::TWiki - save data into a TWiki web site
+#
+# Copyright (c) 2009 Ian Kluft. This program is free software; you can
+# redistribute it and/or modify it under the terms of the GNU General Public
+# License Version 3. See http://www.webfetch.org/GPLv3.txt
+
+package WebFetch::Output::TWiki;
+
+use warnings;
+use strict;
+use WebFetch;
+use base "WebFetch";
+use DB_File;
+
+# define exceptions/errors
+use Exception::Class (
+ "WebFetch::Output::TWiki::Exception::NoRoot" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_twiki_no_root",
+ description => "WebFetch::Output::TWiki needs to be provided "
+ ."a twiki_root parameter",
+ },
+ "WebFetch::Output::TWiki::Exception::NotFound" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_twiki_not_found",
+ description => "the directory in the twiki_root parameter "
+ ."doesn't exist or doesn't have a lib subdirectory",
+ },
+ "WebFetch::Output::TWiki::Exception::Require" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_twiki_require",
+ description => "failed to import TWiki or TWiki::Func modules",
+ },
+ "WebFetch::Output::TWiki::Exception::NoConfig" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_twiki_no_config",
+ description => "WebFetch::Output::TWiki needs to be provided "
+ ."a config_topic parameter",
+ },
+ "WebFetch::Output::TWiki::Exception::ConfigMissing" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_twiki_config_missing",
+ description => "WebFetch::Output::TWiki is missing a required "
+ ."configuration parameter",
+ },
+ "WebFetch::Output::TWiki::Exception::Oops" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_twiki_oops",
+ description => "WebFetch::Output::TWiki returned errors from "
+ ."saving one or more entries",
+ },
+);
+
+=head1 NAME
+
+WebFetch::Output::TWiki - The great new WebFetch::Output::TWiki!
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+# globals/defaults
+our @Options = ( "twiki_root=s", "config_topic=s", "config_key=s" );
+our $Usage = "--twiki_root path-to-twiki --config_topic web.topic "
+ ."--config_key keyword";
+our @default_field_names = ( qw( key web parent prefix template form
+ options ));
+
+# no user-servicable parts beyond this point
+
+our $VERSION = '0.01';
+
+# register capabilities with WebFetch
+__PACKAGE__->module_register( "cmdline", "output:twiki" );
+
+=head1 SYNOPSIS
+
+Quick summary of what the module does.
+
+Perhaps a little code snippet.
+
+ use WebFetch::Output::TWiki;
+
+ my $foo = WebFetch::Output::TWiki->new();
+ ...
+
+=head1 EXPORT
+
+A list of functions that can be exported. You can delete this section
+if you don't export anything, such as for a purely object-oriented module.
+
+=head1 FUNCTIONS
+
+=head2 get_twiki_config
+
+=cut
+
+# read the TWiki configuation
+sub get_twiki_config
+{
+ my $self = shift;
+ WebFetch::debug "in get_twiki_config";
+
+ # find the TWiki modules
+ if ( ! exists $self->{twiki_root}) {
+ throw_twiki_no_root( "TWiki root directory not defined" );
+ }
+ if (( ! -d $self->{twiki_root}) or ( ! -d $self->{twiki_root}."/lib" ))
+ {
+ throw_twiki_not_found( "can't find TWiki root or lib at "
+ .$self->{twiki_root});
+ }
+
+ # load the TWiki modules
+ WebFetch::debug "loading TWiki modules";
+ push @INC, $self->{twiki_root}."/lib";
+ eval { require TWiki; require TWiki::Func; };
+ if ( $@ ) {
+ throw_twiki_require ( $@ );
+ }
+
+ # initiate TWiki library, create session as user "WebFetch"
+ $self->{twiki_obj} = TWiki->new( "WebFetch" );
+
+ # get the contents of the TWiki topic which contains our configuration
+ if ( !exists $self->{config_topic}) {
+ throw_twiki_no_config( "TWiki configuration page for WebFetch "
+ ."not defined" );
+ }
+ my ( $web, $topic ) = split /\./, $self->{config_topic};
+ WebFetch::debug "config_topic: ".$self->{config_topic}
+ ." -> $web, $topic";
+ if (( ! defined $web ) or ( ! defined $topic )) {
+ throw_twiki_no_config( "TWiki configuration page for WebFetch "
+ ."must be defined in the format web.topic" );
+ }
+
+ # check if a config_key was specified before we read the configuration
+ if ( !exists $self->{config_key}) {
+ throw_twiki_no_config( "TWiki configuration key for WebFetch "
+ ."not defined" );
+ }
+
+ # read the configuration info
+ my $config = TWiki::Func::readTopic( $web, $topic );
+
+ # if STARTINCLUDE and STOPINCLUDE are present, use only what's between
+ if ( $config =~ /%STARTINCLUDE%\s*(.*)\s*%STOPINCLUDE%/s ) {
+ $config = $1;
+ }
+
+ # parse the configuration
+ WebFetch::debug "parsing configuration";
+ my ( @fnames, $line );
+ $self->{twiki_config_all} = [];
+ $self->{twiki_keys} = {};
+ foreach $line ( split /\r*\n+/s, $config ) {
+ if ( $line =~ /^\|\s*(.*)\s*\|\s*$/ ) {
+ my @entries = split /\s*\|\s*/, $1;
+
+ # check first line for field headings
+ if ( ! @{$self->{twiki_config_all}}) {
+ if ( $entries[0] =~ /\*\w+\*/ ) {
+ # save table headings as field names
+ my $field;
+ foreach $field ( @entries ) {
+ if ( $field =~ /\*(\w*)\*/ )
+ {
+ push @fnames, lc($1);
+ } else {
+ my $tmp = lc($field);
+ $tmp =~ s/\W//g;
+ push @fnames, $tmp;
+ }
+ }
+ next;
+ } else {
+ # use default field names
+ @fnames = @default_field_names;
+ }
+ }
+ WebFetch::debug "field names: ".join " ", @fnames;
+
+ # save the entries
+ # it isn't a heading row if we got here
+ # transfer array @entries to named fields in %config
+ WebFetch::debug "data row: ".join " ", @entries;
+ my ( $i, $key, %config );
+ for ( $i=0; $i < scalar @fnames; $i++ ) {
+ $config{ $fnames[$i]} = $entries[$i];
+ if ( $fnames[$i] eq "key" ) {
+ $key = $entries[$i];
+ }
+ }
+
+ # save the %config row in @{$self->{twiki_config_all}}
+ if (( defined $key )
+ and ( !exists $self->{twiki_keys}{$key}))
+ {
+ push @{$self->{twiki_config_all}}, \%config;
+ $self->{twiki_keys}{$key} = ( scalar
+ @{$self->{twiki_config_all}}) - 1;
+ }
+ }
+ }
+
+ # select the line which is for this request
+ if ( ! exists $self->{twiki_keys}{$self->{config_key}}) {
+ throw_twiki_no_config "no configuration found for key "
+ .$self->{config_key};
+ }
+ $self->{twiki_config} = $self->{twiki_config_all}[$self->{twiki_keys}{$self->{config_key}}];
+ WebFetch::debug "twiki_config: ".join( " ", %{$self->{twiki_config}});
+}
+
+=head2 write_to_twiki
+
+=cut
+
+sub write_to_twiki
+{
+ my $self = shift;
+ my ( $config, $name );
+
+ # get config variables
+ $config = $self->{twiki_config};
+ foreach $name ( qw( key web parent prefix template form )) {
+ if ( !exists $self->{twiki_config}{$name}) {
+ throw_twiki_config_missing( "missing config parameter "
+ .$name );
+ }
+ }
+
+ # get text of template topic
+ my $template = TWiki::Func::readTopic( $config->{web},
+ $config->{template});
+
+ # determine unique identifier field
+ my $id_field = $self->wk2fnum( "id" );
+ if ( ! defined $id_field ) {
+ $id_field = $self->wk2fnum( "url" );
+ } elsif ( ! defined $id_field ) {
+ $id_field = $self->wk2fnum( "title" );
+ }
+ WebFetch::debug "write_to_twiki: id_field=$id_field";
+
+ # open DB file for tracking unique IDs of articles already processed
+ my %id_index;
+ tie %id_index, 'DB_File',
+ $self->{dir}."/".$config->{key}."_id_index.db",
+ &DB_File::O_CREAT|&DB_File::O_RDWR, 0640;
+
+ # determine initial topic name
+ my ( %topics, @topics );
+ @topics = TWiki::Func::getTopicList( $config->{web});
+ foreach ( @topics ) {
+ $topics{$_} = 1;
+ }
+ my $tnum_counter = 0;
+ my $tnum_format = $config->{prefix}."-%07d";
+
+ # create topics with metadata from each WebFetch data record
+ my $entry;
+ my @oopses;
+ foreach $entry ( @{$self->{data}{records}}) {
+
+ # check that this entry hasn't already been forwarded to TWiki
+ if ( exists $id_index{$entry->[$id_field]}) {
+ next;
+ }
+ $id_index{$entry->[$id_field]} = time;
+
+ # select topic name
+ my $topicname = sprintf $tnum_format, $tnum_counter;
+ while ( exists $topics{$topicname}) {
+ $tnum_counter++;
+ $topicname = sprintf $tnum_format, $tnum_counter;
+ }
+ $tnum_counter++;
+ $topics{$topicname} = 1;
+ my $text = $template;
+ WebFetch::debug "write_to_twiki: writing $topicname";
+
+ # create topic metadata
+ my $meta = TWiki::Meta->new ( $self->{twiki_obj},
+ $config->{web}, $topicname );
+ $meta->put( "TOPICPARENT",
+ { name => $config->{parent}});
+ $meta->put( "FORM", { name => $config->{form}});
+ my $fnum;
+ for ( $fnum = 0; $fnum <= @{$self->{data}{fields}}; $fnum++ ) {
+ WebFetch::debug "meta: ".$self->{data}{fields}[$fnum]
+ ." = ".$entry->[$fnum];
+ ( defined $self->{data}{fields}[$fnum]) or next;
+ ( $self->{data}{fields}[$fnum] eq "xml") and next;
+ ( defined $entry->[$fnum]) or next;
+ WebFetch::debug "meta: OK";
+ $meta->putKeyed( "FIELD", {
+ name => $self->{data}{fields}[$fnum],
+ value => $entry->[$fnum] });
+ }
+
+ # save a special title field for TWiki indexes
+ my $index_title = $entry->[$self->wk2fnum( "title" )];
+ $index_title =~ s/[\t\r\n\|]+/ /gs;
+ $index_title =~ s/^\s*//;
+ $index_title =~ s/\s*$//;
+ if ( length($index_title) > 60 ) {
+ substr( $index_title, 56 ) = "...";
+ }
+ WebFetch::debug "title: $index_title";
+ $meta->putKeyed( "FIELD", {
+ name => "IndexTitle",
+ title => "Indexing title",
+ value => $index_title });
+
+ # save the topic
+ my $oopsurl = TWiki::Func::saveTopic( $config->{web},
+ $topicname, $meta, $text );
+ if ( $oopsurl ) {
+ WebFetch::debug "write_to_twiki: $topicname - $oopsurl";
+ push @oopses, $entry->[$self->wk2fnum( "title" ) or 0]
+ ." -> ".$topicname." ".$oopsurl;
+ }
+ }
+
+ # check for errors
+ if ( @oopses ) {
+ throw_twiki_oops( "These saves failed:\n".join "\n", @oopses );
+ }
+}
+
+=head2 fmt_handler_twiki
+
+=cut
+
+# TWiki format handler
+sub fmt_handler_twiki
+{
+ my $self = shift;
+ my $filename = shift;
+
+ # get configuration from TWiki
+ $self->get_twiki_config;
+
+ # write to TWiki topic
+ $self->write_to_twiki;
+
+ # no savables for WebFetch::save - mark it OK
+ $self->no_savables_ok;
+ 1;
+}
+
+
+=head1 AUTHOR
+
+Ian Kluft, C<< <ikluft at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-webfetch-output-twiki at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebFetch-Output-TWiki>. 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 WebFetch::Output::TWiki
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WebFetch-Output-TWiki>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/WebFetch-Output-TWiki>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/WebFetch-Output-TWiki>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/WebFetch-Output-TWiki/>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2009 Ian Kluft, 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; # End of WebFetch::Output::TWiki
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
