Menu
▾
▴
[Webfetch-commits] SF.net SVN: webfetch:[68] trunk
|
From: <ik...@us...> - 2009-09-21 04:59:30
|
Revision: 68
http://webfetch.svn.sourceforge.net/webfetch/?rev=68&view=rev
Author: ikluft
Date: 2009-09-21 04:59:20 +0000 (Mon, 21 Sep 2009)
Log Message:
-----------
merge 0.13 to trunk
Modified Paths:
--------------
trunk/MANIFEST
trunk/lib/WebFetch/Input/Atom.pm
trunk/lib/WebFetch/Input/PerlStruct.pm
trunk/lib/WebFetch/Input/RSS.pm
trunk/lib/WebFetch/Input/SiteNews.pm
trunk/lib/WebFetch/Output/Dump.pm
trunk/lib/WebFetch/Output/TT.pm
trunk/lib/WebFetch.pm
trunk/t/00-load.t
trunk/t/pod-coverage.t
Added Paths:
-----------
trunk/lib/WebFetch/Data/
trunk/lib/WebFetch/Data/Record.pm
trunk/lib/WebFetch/Data/Store.pm
trunk/lib/WebFetch/Output/TWiki.pm
Removed Paths:
-------------
trunk/lib/WebFetch/Data/Record.pm
trunk/lib/WebFetch/Data/Store.pm
Property Changed:
----------------
trunk/
Property changes on: trunk
___________________________________________________________________
Modified: svn:mergeinfo
- /trunk:38
+ /branches/v0.13:44-67
/trunk:38
Modified: trunk/MANIFEST
===================================================================
--- trunk/MANIFEST 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/MANIFEST 2009-09-21 04:59:20 UTC (rev 68)
@@ -11,3 +11,10 @@
lib/WebFetch/Input/SiteNews.pm
lib/WebFetch/Output/Dump.pm
lib/WebFetch/Output/TT.pm
+lib/WebFetch/Output/TWiki.pm
+lib/WebFetch/Data/Store.pm
+lib/WebFetch/Data/Record.pm
+t/00-load.t
+t/boilerplate.t
+t/pod-coverage.t
+t/pod.t
Deleted: trunk/lib/WebFetch/Data/Record.pm
===================================================================
--- branches/v0.13/lib/WebFetch/Data/Record.pm 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/lib/WebFetch/Data/Record.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -1,212 +0,0 @@
-#
-# WebFetch::Data::Record - WebFetch Embedding API data record
-#
-# 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::Data::Record;
-
-use strict;
-use warnings;
-use base qw( WebFetch );
-
-# define exceptions/errors
-use Exception::Class (
- 'WebFetch::Data::Record::Exception::AutoloadFailure' => {
- isa => 'WebFetch::TracedException',
- alias => 'throw_autoload_fail',
- description => "AUTOLOAD failed to handle function call",
- },
-
-);
-
-# no user-servicable parts beyond this point
-
-=head1 NAME
-
-WebFetch::Data::Record - Object for management of WebFetch data records/rows
-
-=head1 SYNOPSIS
-
-C<use WebFetch::Data::Record;>
-
-C<WebFetch::Data::Record->mk_field_accessor( $field_name, ... );
-$value = $obj-E<gt>bynum( $num );
-$value = $obj->fieldname;
-$obj->fieldname( $value );
->
-
-=head1 DESCRIPTION
-
-This module provides read-only access to a single record of the WebFetch data.
-
-=cut
-
-our $AUTOLOAD;
-
-# initialization
-sub init
-{
- my $self = shift;
-
- # save parameters
- $self->{obj} = shift;
- $self->{num} = shift;
- $self->{recref} = $self->{obj}{records}[$self->{num}];
-
- # signal WebFetch that Data subclasses do not provide a fetch function
- $self->{no_fetch} = 1;
- $self->SUPER::init( @_ );
-
- # make accessor functions
- my $field;
- my $class = ref( $self );
- foreach $field ( @{$self->{obj}{fields}}) {
- $class->mk_field_accessor( $field );
- }
- foreach $field ( keys %{$self->{obj}{wk_names}}) {
- $class->mk_field_accessor( $field );
- }
-
- return $self;
-}
-
-# shortcut function to top-level WebFetch object data
-sub data { return $_[0]->{obj}; }
-
-=item $value = $obj->bynum( $field_num );
-
-Returns the value of the field located by the field number provided.
-The first field is numbered 0.
-
-=cut
-
-# get a field by number
-sub bynum
-{
- my $self = shift;
- my $f = shift;
-
- WebFetch::debug "bynum $f";
- return $self->{recref}[$f];
-}
-
-=item $value = $obj->byname( $field_name );
-
-Returns the value of the named field.
-
-=cut
-
-# get a field by name
-sub byname
-{
- my $self = shift;
- my $fname = shift;
- my $obj = $self->{obj};
- my $f;
-
- WebFetch::debug "byname ".(( defined $fname ) ? $fname : "undef");
- ( defined $fname ) or return undef;
- if ( exists $obj->{findex}{$fname}) {
- $f = $obj->{findex}{$fname};
- return $self->{recref}[$f];
- }
- return undef;
-}
-
-=item $class->mk_field_accessor( $field_name, ... );
-
-Creates accessor functions for each field name provided.
-
-=cut
-
-# make field accessor/mutator functions
-sub mk_field_accessor
-{
- my $class = shift;
- my $name;
-
- foreach $name ( @_ ) {
- no strict 'refs';
- $class->can( $name ) and next; # skip if function exists!
-
- # make a closure which keeps value of $name from this call
- # keep generic so code can use more than one data type per run
- *{$class."::".$name} = sub {
- my $self = shift;
- my $value = shift;
- my $obj = $self->{obj};
- my $recref = $self->{recref};
- my $f;
- if ( exists $obj->{findex}{$name}) {
- $f = $obj->{findex}{$name};
- if ( defined $value ) {
- my $tmp = $recref->[$f];
- $recref->[$f] = $value;
- return $tmp;
- } else {
- return $recref->[$f];
- }
- } elsif ( exists $obj->{wk_names}{$name}) {
- my $wk = $obj->{wk_names}{$name};
- $f = $obj->{findex}{$wk};
- if ( defined $value ) {
- my $tmp = $recref->[$f];
- $recref->[$f] = $value;
- return $tmp;
- } else {
- return $recref->[$f];
- }
- } else {
- return undef;
- }
- };
- }
-}
-
-=item accessor functions
-
-Accessor functions are created for field names and
-well-known names as they are defined.
-
-So a field named "title" can be accessed by an object method of the same
-name, like $obj->title .
-
-=cut
-
-# AUTOLOAD function to provide field accessors/mutators
-sub AUTOLOAD
-{
- my $self = shift;
- my $type = ref($self) or throw_autoload_fail "self is not an object";
-
- my $name = $AUTOLOAD;
- $name =~ s/.*://; # strip fully-qualified portion, just want function
-
- # decline all-caps names - reserved for special Perl functions
- ( $name =~ /^[A-Z]+$/ ) and return;
-
- WebFetch::debug __PACKAGE__."::AUTOLOAD $name";
- if (( exists $self->{obj}{findex}{$name})
- or ( exists $self->{obj}{wk_names}{$name}))
- {
- $type->mk_field_accessor( $name );
- return $self->$name(@_);
- } else {
- throw_autoload_fail "no such function or field $name";
- }
-}
-
-1;
-__END__
-=head1 AUTHOR
-
-WebFetch was written by Ian Kluft
-Send patches, bug reports, suggestions and questions to
-C<ma...@we...>.
-
-=head1 SEE ALSO
-
-L<WebFetch>, L<WebFetch::Data::Record>
Copied: trunk/lib/WebFetch/Data/Record.pm (from rev 67, branches/v0.13/lib/WebFetch/Data/Record.pm)
===================================================================
--- trunk/lib/WebFetch/Data/Record.pm (rev 0)
+++ trunk/lib/WebFetch/Data/Record.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -0,0 +1,212 @@
+#
+# WebFetch::Data::Record - WebFetch Embedding API data record
+#
+# 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::Data::Record;
+
+use strict;
+use warnings;
+use base qw( WebFetch );
+
+# define exceptions/errors
+use Exception::Class (
+ 'WebFetch::Data::Record::Exception::AutoloadFailure' => {
+ isa => 'WebFetch::TracedException',
+ alias => 'throw_autoload_fail',
+ description => "AUTOLOAD failed to handle function call",
+ },
+
+);
+
+# no user-servicable parts beyond this point
+
+=head1 NAME
+
+WebFetch::Data::Record - Object for management of WebFetch data records/rows
+
+=head1 SYNOPSIS
+
+C<use WebFetch::Data::Record;>
+
+C<WebFetch::Data::Record->mk_field_accessor( $field_name, ... );
+$value = $obj-E<gt>bynum( $num );
+$value = $obj->fieldname;
+$obj->fieldname( $value );
+>
+
+=head1 DESCRIPTION
+
+This module provides read-only access to a single record of the WebFetch data.
+
+=cut
+
+our $AUTOLOAD;
+
+# initialization
+sub init
+{
+ my $self = shift;
+
+ # save parameters
+ $self->{obj} = shift;
+ $self->{num} = shift;
+ $self->{recref} = $self->{obj}{records}[$self->{num}];
+
+ # signal WebFetch that Data subclasses do not provide a fetch function
+ $self->{no_fetch} = 1;
+ $self->SUPER::init( @_ );
+
+ # make accessor functions
+ my $field;
+ my $class = ref( $self );
+ foreach $field ( @{$self->{obj}{fields}}) {
+ $class->mk_field_accessor( $field );
+ }
+ foreach $field ( keys %{$self->{obj}{wk_names}}) {
+ $class->mk_field_accessor( $field );
+ }
+
+ return $self;
+}
+
+# shortcut function to top-level WebFetch object data
+sub data { return $_[0]->{obj}; }
+
+=item $value = $obj->bynum( $field_num );
+
+Returns the value of the field located by the field number provided.
+The first field is numbered 0.
+
+=cut
+
+# get a field by number
+sub bynum
+{
+ my $self = shift;
+ my $f = shift;
+
+ WebFetch::debug "bynum $f";
+ return $self->{recref}[$f];
+}
+
+=item $value = $obj->byname( $field_name );
+
+Returns the value of the named field.
+
+=cut
+
+# get a field by name
+sub byname
+{
+ my $self = shift;
+ my $fname = shift;
+ my $obj = $self->{obj};
+ my $f;
+
+ WebFetch::debug "byname ".(( defined $fname ) ? $fname : "undef");
+ ( defined $fname ) or return undef;
+ if ( exists $obj->{findex}{$fname}) {
+ $f = $obj->{findex}{$fname};
+ return $self->{recref}[$f];
+ }
+ return undef;
+}
+
+=item $class->mk_field_accessor( $field_name, ... );
+
+Creates accessor functions for each field name provided.
+
+=cut
+
+# make field accessor/mutator functions
+sub mk_field_accessor
+{
+ my $class = shift;
+ my $name;
+
+ foreach $name ( @_ ) {
+ no strict 'refs';
+ $class->can( $name ) and next; # skip if function exists!
+
+ # make a closure which keeps value of $name from this call
+ # keep generic so code can use more than one data type per run
+ *{$class."::".$name} = sub {
+ my $self = shift;
+ my $value = shift;
+ my $obj = $self->{obj};
+ my $recref = $self->{recref};
+ my $f;
+ if ( exists $obj->{findex}{$name}) {
+ $f = $obj->{findex}{$name};
+ if ( defined $value ) {
+ my $tmp = $recref->[$f];
+ $recref->[$f] = $value;
+ return $tmp;
+ } else {
+ return $recref->[$f];
+ }
+ } elsif ( exists $obj->{wk_names}{$name}) {
+ my $wk = $obj->{wk_names}{$name};
+ $f = $obj->{findex}{$wk};
+ if ( defined $value ) {
+ my $tmp = $recref->[$f];
+ $recref->[$f] = $value;
+ return $tmp;
+ } else {
+ return $recref->[$f];
+ }
+ } else {
+ return undef;
+ }
+ };
+ }
+}
+
+=item accessor functions
+
+Accessor functions are created for field names and
+well-known names as they are defined.
+
+So a field named "title" can be accessed by an object method of the same
+name, like $obj->title .
+
+=cut
+
+# AUTOLOAD function to provide field accessors/mutators
+sub AUTOLOAD
+{
+ my $self = shift;
+ my $type = ref($self) or throw_autoload_fail "self is not an object";
+
+ my $name = $AUTOLOAD;
+ $name =~ s/.*://; # strip fully-qualified portion, just want function
+
+ # decline all-caps names - reserved for special Perl functions
+ ( $name =~ /^[A-Z]+$/ ) and return;
+
+ WebFetch::debug __PACKAGE__."::AUTOLOAD $name";
+ if (( exists $self->{obj}{findex}{$name})
+ or ( exists $self->{obj}{wk_names}{$name}))
+ {
+ $type->mk_field_accessor( $name );
+ return $self->$name(@_);
+ } else {
+ throw_autoload_fail "no such function or field $name";
+ }
+}
+
+1;
+__END__
+=head1 AUTHOR
+
+WebFetch was written by Ian Kluft
+Send patches, bug reports, suggestions and questions to
+C<ma...@we...>.
+
+=head1 SEE ALSO
+
+L<WebFetch>, L<WebFetch::Data::Record>
Deleted: trunk/lib/WebFetch/Data/Store.pm
===================================================================
--- branches/v0.13/lib/WebFetch/Data/Store.pm 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/lib/WebFetch/Data/Store.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -1,359 +0,0 @@
-#
-# WebFetch::Data::Store - WebFetch Embedding API top-level data store
-#
-# 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
-#
-# The WebFetch Embedding API manages the following data:
-# * {data} - top level hash container (WebFetch::Data::Store)
-# * {fields} - array of field names
-# * {records} - array of data records (WebFetch::Data::Record)
-# * each record is an array of data fields in the order of the field names
-# * {wk_names} - hash of WebFetch well-known fields to actual field names
-# * {feed} - top-level arbitrary info about the feed
-#
-
-package WebFetch::Data::Store;
-
-use strict;
-use warnings;
-use WebFetch;
-use base qw( WebFetch );
-
-# define exceptions/errors
-use Exception::Class (
-);
-
-# no user-servicable parts beyond this point
-
-=head1 NAME
-
-WebFetch::Data::Store - Object for management of WebFetch data
-
-=head1 SYNOPSIS
-
-C<use WebFetch::Data::Store;>
-
-C<$data = webfetch_obj-E<gt>data;
-$data-E<gt>add_fields( "field1", "field2", ... );
-$num = $data-E<gt>num_fields;
-@field_names = $data-E<gt>get_fields;
-$name = $data-E<gt>field_bynum( 3 );
-$data-E<gt>add_wk_names( "title" =E<gt> "heading", "url" =E<gt> "link", ... );
-$value = $data-E<gt>get_feed( $name );
-$data-E<gt>set_feed( $name, $value );
-$data-E<gt>add_record( $field1, $field2, ... ); # order corresponds to add_fields
-$num = $data-E<gt>num_records;
-$record = $data-E<gt>get_record( $n );
-$data-E<gt>reset_pos;
-$record = $data-E<gt>next_record;
-$name = $data-E<gt>wk2fname( $wk_name );
-$num = $data-E<gt>fname2fnum( $field_name );
-$num = $data-E<gt>wk2fnum( $wk_name );
->
-
-=head1 DESCRIPTION
-
-This module provides access to the WebFetch data.
-WebFetch instantiates the object for the input module.
-The input module uses this to construct the data set from its input.
-The output module uses the this to access the data and
-produce its output object/format.
-
-=cut
-
-# initialization
-sub init
-{
- my $self = shift;
- $self->{fields} = [];
- $self->{findex} = {};
- $self->{records} = [];
- $self->{wk_names} = {};
- $self->{wkindex} = {};
- $self->{feed} = {};
-
- # signal WebFetch that Data subclasses do not provide a fetch function
- $self->{no_fetch} = 1;
- $self->SUPER::init( @_ );
-
- return $self;
-}
-
-=item $obj->add_fields( "field1", "field2", ... );
-
-Add the field names in the order their values will appear in the data table.
-
-=cut
-
-# add field names
-sub add_fields
-{
- my $self = shift;
- my @fields = @_;
- my $field;
- foreach $field ( @fields ) {
- $self->{findex}{$field} = scalar @{$self->{fields}};
- push @{$self->{fields}}, $field;
- }
-}
-
-=item $num = $obj->num_fields;
-
-Returns the number of fields/columns in the data.
-
-=cut
-
-# get number of fields
-sub num_fields
-{
- my $self = shift;
- return scalar @{$self->{fields}};
-}
-
-=item @field_names = $obj->get_fields;
-
-Gets a list of the field names in the order their values appear in the data
-table;
-
-=cut
-
-# get field names
-sub get_fields
-{
- my $self = shift;
- return keys %{$self->{fields}};
-}
-
-=item $field_name = $obj->field_bynum( $num );
-
-Return a field name string based on the numeric position of the field.
-
-=cut
-
-# get field name by number
-sub field_bynum
-{
- my $self = shift;
- my $num = shift;
- return $self->{fields}[$num];
-}
-
-=item $obj->add_wk_names( "title" => "heading", "url" => "link", ... );
-
-Add associations between WebFetch well-known field names, which allows
-WebFetch to apply meaning to these fields, such as titles, dates and URLs.
-The parameters are pairs of well-known and actual field names.
-Running this function more than once will add to the existing associations
-of well-known to actual field names.
-
-=cut
-
-# add well-known names
-sub add_wk_names
-{
- my $self = shift;
- my ( $wk_name, $field );
-
- while ( @_ >= 2 ) {
- $wk_name = shift;
- $field = shift;
- WebFetch::debug "add_wk_names $wk_name => $field";
- $self->{wk_names}{$wk_name} = $field;
- $self->{wkindex}{$wk_name} = $self->{findex}{$field};
- }
-}
-
-=item $value = $obj->get_feed( $name );
-
-Get an item of per-feed data by name.
-
-=cut
-
-# get feed info
-sub get_feed
-{
- my $self = shift;
- my $name = shift;
- return (exists $self->{$name}) ? $self->{$name} : undef;
-}
-
-=item $obj->set_feed( $name, $value );
-
-Set an item of per-feed data by name and value.
-
-=cut
-
-# set feed info
-sub set_feed
-{
- my $self = shift;
- my $name = shift;
- my $value = shift;
- my $retval = (exists $self->{$name}) ? $self->{$name} : undef;
- $self->{$name} = $value;
- return $retval;
-}
-
-=item $obj->add_record( $value1, $value2, $value3, ... );
-
-Add a row to the end of the data table. Values must correspond to the
-positions of the field names that were provided earlier.
-
-=cut
-
-# add a data record
-# this adds the field values in the same order the field names were added
-sub add_record
-{
- my $self = shift;
- push @{$self->{records}}, [ @_ ];
-}
-
-# TODO: add a function add_record_unordered( name => value, ... )
-# less efficient, but may be OK for cases where that doesn't matter
-
-=item $num = $obj->num_records;
-
-Get the number of records/rows in the data table.
-
-=cut
-
-# get the number of data records
-sub num_records
-{
- my $self = shift;
- return scalar @{$self->{records}};
-}
-
-=item $record = get_record( $num );
-
-Returns a WebFetch::Data::Record object for the row located
-by the given row number in the data table. The first row is numbered 0.
-Calling this function does not affect the position used by the next_record
-function.
-
-=cut
-
-# get a data record by index
-sub get_record
-{
- my $self = shift;
- my $n = shift;
- WebFetch::debug "get_record $n";
- require WebFetch::Data::Record;
- return WebFetch::Data::Record->new( $self, $n );
-}
-
-=item $obj->reset_pos;
-
-Reset the position counter used by the next_record function back to the
-beginning of the data table.
-
-=cut
-
-# reset iterator position
-sub reset_pos
-{
- my $self = shift;
-
- WebFetch::debug "reset_pos";
- delete $self->{pos};
-}
-
-=item $record = $obj->next_record;
-
-The first call to this function returns the first record.
-Each successive call to this function returns the following record until
-the end of the data table.
-After the last record, the function returns undef until
-reset_pos is called to reset it back to the beginning.
-
-=cut
-
-# get next record
-sub next_record
-{
- my $self = shift;
-
- # initialize if necessary
- if ( !exists $self->{pos}) {
- $self->{pos} = 0;
- }
- WebFetch::debug "next_record n=".$self->{pos}." of "
- .scalar @{$self->{records}};
-
- # return undef if position is out of bounds
- ( $self->{pos} < 0 ) and return undef;
- ( $self->{pos} > scalar @{$self->{records}} - 1 ) and return undef;
-
- # get record
- return $self->get_record( $self->{pos}++ );
-}
-
-=item $obj->wk2fname( $wk )
-
-Obtain a field name from a well-known name.
-
-=cut
-
-# convert well-known name to field name
-sub wk2fname
-{
- my $self = shift;
- my $wk = shift;
-
- WebFetch::debug "wk2fname $wk => ".(( exists $self->{wk_names}{$wk}) ? $self->{wk_names}{$wk} : "undef");
- return ( exists $self->{wk_names}{$wk})
- ? $self->{wk_names}{$wk}
- : undef;
-}
-
-=item $obj->fname2fnum( $fname )
-
-Obtain a field number from a field name.
-
-=cut
-
-# convert a field name to a field number
-sub fname2fnum
-{
- my $self = shift;
- my $fname = shift;
-
- WebFetch::debug "fname2fnum $fname => ".(( exists $self->{findex}{$fname}) ? $self->{findex}{$fname} : "undef" );
- return ( exists $self->{findex}{$fname})
- ? $self->{findex}{$fname}
- : undef;
-}
-
-=item $obj->wk2fnum( $wk )
-
-Obtain a field number from a well-known name.
-
-=cut
-
-# convert well-known name to field number
-sub wk2fnum
-{
- my $self = shift;
- my $wk = shift;
-
- WebFetch::debug "wk2fnum $wk => ".(( exists $self->{wkindex}{$wk}) ? $self->{wkindex}{$wk} : "undef" );
- return ( exists $self->{wkindex}{$wk})
- ? $self->{wkindex}{$wk}
- : undef;
-}
-
-1;
-__END__
-=head1 AUTHOR
-
-WebFetch was written by Ian Kluft
-Send patches, bug reports, suggestions and questions to
-C<ma...@we...>.
-
-=head1 SEE ALSO
-
-L<WebFetch>, L<WebFetch::Data::Record>
Copied: trunk/lib/WebFetch/Data/Store.pm (from rev 67, branches/v0.13/lib/WebFetch/Data/Store.pm)
===================================================================
--- trunk/lib/WebFetch/Data/Store.pm (rev 0)
+++ trunk/lib/WebFetch/Data/Store.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -0,0 +1,359 @@
+#
+# WebFetch::Data::Store - WebFetch Embedding API top-level data store
+#
+# 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
+#
+# The WebFetch Embedding API manages the following data:
+# * {data} - top level hash container (WebFetch::Data::Store)
+# * {fields} - array of field names
+# * {records} - array of data records (WebFetch::Data::Record)
+# * each record is an array of data fields in the order of the field names
+# * {wk_names} - hash of WebFetch well-known fields to actual field names
+# * {feed} - top-level arbitrary info about the feed
+#
+
+package WebFetch::Data::Store;
+
+use strict;
+use warnings;
+use WebFetch;
+use base qw( WebFetch );
+
+# define exceptions/errors
+use Exception::Class (
+);
+
+# no user-servicable parts beyond this point
+
+=head1 NAME
+
+WebFetch::Data::Store - Object for management of WebFetch data
+
+=head1 SYNOPSIS
+
+C<use WebFetch::Data::Store;>
+
+C<$data = webfetch_obj-E<gt>data;
+$data-E<gt>add_fields( "field1", "field2", ... );
+$num = $data-E<gt>num_fields;
+@field_names = $data-E<gt>get_fields;
+$name = $data-E<gt>field_bynum( 3 );
+$data-E<gt>add_wk_names( "title" =E<gt> "heading", "url" =E<gt> "link", ... );
+$value = $data-E<gt>get_feed( $name );
+$data-E<gt>set_feed( $name, $value );
+$data-E<gt>add_record( $field1, $field2, ... ); # order corresponds to add_fields
+$num = $data-E<gt>num_records;
+$record = $data-E<gt>get_record( $n );
+$data-E<gt>reset_pos;
+$record = $data-E<gt>next_record;
+$name = $data-E<gt>wk2fname( $wk_name );
+$num = $data-E<gt>fname2fnum( $field_name );
+$num = $data-E<gt>wk2fnum( $wk_name );
+>
+
+=head1 DESCRIPTION
+
+This module provides access to the WebFetch data.
+WebFetch instantiates the object for the input module.
+The input module uses this to construct the data set from its input.
+The output module uses the this to access the data and
+produce its output object/format.
+
+=cut
+
+# initialization
+sub init
+{
+ my $self = shift;
+ $self->{fields} = [];
+ $self->{findex} = {};
+ $self->{records} = [];
+ $self->{wk_names} = {};
+ $self->{wkindex} = {};
+ $self->{feed} = {};
+
+ # signal WebFetch that Data subclasses do not provide a fetch function
+ $self->{no_fetch} = 1;
+ $self->SUPER::init( @_ );
+
+ return $self;
+}
+
+=item $obj->add_fields( "field1", "field2", ... );
+
+Add the field names in the order their values will appear in the data table.
+
+=cut
+
+# add field names
+sub add_fields
+{
+ my $self = shift;
+ my @fields = @_;
+ my $field;
+ foreach $field ( @fields ) {
+ $self->{findex}{$field} = scalar @{$self->{fields}};
+ push @{$self->{fields}}, $field;
+ }
+}
+
+=item $num = $obj->num_fields;
+
+Returns the number of fields/columns in the data.
+
+=cut
+
+# get number of fields
+sub num_fields
+{
+ my $self = shift;
+ return scalar @{$self->{fields}};
+}
+
+=item @field_names = $obj->get_fields;
+
+Gets a list of the field names in the order their values appear in the data
+table;
+
+=cut
+
+# get field names
+sub get_fields
+{
+ my $self = shift;
+ return keys %{$self->{fields}};
+}
+
+=item $field_name = $obj->field_bynum( $num );
+
+Return a field name string based on the numeric position of the field.
+
+=cut
+
+# get field name by number
+sub field_bynum
+{
+ my $self = shift;
+ my $num = shift;
+ return $self->{fields}[$num];
+}
+
+=item $obj->add_wk_names( "title" => "heading", "url" => "link", ... );
+
+Add associations between WebFetch well-known field names, which allows
+WebFetch to apply meaning to these fields, such as titles, dates and URLs.
+The parameters are pairs of well-known and actual field names.
+Running this function more than once will add to the existing associations
+of well-known to actual field names.
+
+=cut
+
+# add well-known names
+sub add_wk_names
+{
+ my $self = shift;
+ my ( $wk_name, $field );
+
+ while ( @_ >= 2 ) {
+ $wk_name = shift;
+ $field = shift;
+ WebFetch::debug "add_wk_names $wk_name => $field";
+ $self->{wk_names}{$wk_name} = $field;
+ $self->{wkindex}{$wk_name} = $self->{findex}{$field};
+ }
+}
+
+=item $value = $obj->get_feed( $name );
+
+Get an item of per-feed data by name.
+
+=cut
+
+# get feed info
+sub get_feed
+{
+ my $self = shift;
+ my $name = shift;
+ return (exists $self->{$name}) ? $self->{$name} : undef;
+}
+
+=item $obj->set_feed( $name, $value );
+
+Set an item of per-feed data by name and value.
+
+=cut
+
+# set feed info
+sub set_feed
+{
+ my $self = shift;
+ my $name = shift;
+ my $value = shift;
+ my $retval = (exists $self->{$name}) ? $self->{$name} : undef;
+ $self->{$name} = $value;
+ return $retval;
+}
+
+=item $obj->add_record( $value1, $value2, $value3, ... );
+
+Add a row to the end of the data table. Values must correspond to the
+positions of the field names that were provided earlier.
+
+=cut
+
+# add a data record
+# this adds the field values in the same order the field names were added
+sub add_record
+{
+ my $self = shift;
+ push @{$self->{records}}, [ @_ ];
+}
+
+# TODO: add a function add_record_unordered( name => value, ... )
+# less efficient, but may be OK for cases where that doesn't matter
+
+=item $num = $obj->num_records;
+
+Get the number of records/rows in the data table.
+
+=cut
+
+# get the number of data records
+sub num_records
+{
+ my $self = shift;
+ return scalar @{$self->{records}};
+}
+
+=item $record = get_record( $num );
+
+Returns a WebFetch::Data::Record object for the row located
+by the given row number in the data table. The first row is numbered 0.
+Calling this function does not affect the position used by the next_record
+function.
+
+=cut
+
+# get a data record by index
+sub get_record
+{
+ my $self = shift;
+ my $n = shift;
+ WebFetch::debug "get_record $n";
+ require WebFetch::Data::Record;
+ return WebFetch::Data::Record->new( $self, $n );
+}
+
+=item $obj->reset_pos;
+
+Reset the position counter used by the next_record function back to the
+beginning of the data table.
+
+=cut
+
+# reset iterator position
+sub reset_pos
+{
+ my $self = shift;
+
+ WebFetch::debug "reset_pos";
+ delete $self->{pos};
+}
+
+=item $record = $obj->next_record;
+
+The first call to this function returns the first record.
+Each successive call to this function returns the following record until
+the end of the data table.
+After the last record, the function returns undef until
+reset_pos is called to reset it back to the beginning.
+
+=cut
+
+# get next record
+sub next_record
+{
+ my $self = shift;
+
+ # initialize if necessary
+ if ( !exists $self->{pos}) {
+ $self->{pos} = 0;
+ }
+ WebFetch::debug "next_record n=".$self->{pos}." of "
+ .scalar @{$self->{records}};
+
+ # return undef if position is out of bounds
+ ( $self->{pos} < 0 ) and return undef;
+ ( $self->{pos} > scalar @{$self->{records}} - 1 ) and return undef;
+
+ # get record
+ return $self->get_record( $self->{pos}++ );
+}
+
+=item $obj->wk2fname( $wk )
+
+Obtain a field name from a well-known name.
+
+=cut
+
+# convert well-known name to field name
+sub wk2fname
+{
+ my $self = shift;
+ my $wk = shift;
+
+ WebFetch::debug "wk2fname $wk => ".(( exists $self->{wk_names}{$wk}) ? $self->{wk_names}{$wk} : "undef");
+ return ( exists $self->{wk_names}{$wk})
+ ? $self->{wk_names}{$wk}
+ : undef;
+}
+
+=item $obj->fname2fnum( $fname )
+
+Obtain a field number from a field name.
+
+=cut
+
+# convert a field name to a field number
+sub fname2fnum
+{
+ my $self = shift;
+ my $fname = shift;
+
+ WebFetch::debug "fname2fnum $fname => ".(( exists $self->{findex}{$fname}) ? $self->{findex}{$fname} : "undef" );
+ return ( exists $self->{findex}{$fname})
+ ? $self->{findex}{$fname}
+ : undef;
+}
+
+=item $obj->wk2fnum( $wk )
+
+Obtain a field number from a well-known name.
+
+=cut
+
+# convert well-known name to field number
+sub wk2fnum
+{
+ my $self = shift;
+ my $wk = shift;
+
+ WebFetch::debug "wk2fnum $wk => ".(( exists $self->{wkindex}{$wk}) ? $self->{wkindex}{$wk} : "undef" );
+ return ( exists $self->{wkindex}{$wk})
+ ? $self->{wkindex}{$wk}
+ : undef;
+}
+
+1;
+__END__
+=head1 AUTHOR
+
+WebFetch was written by Ian Kluft
+Send patches, bug reports, suggestions and questions to
+C<ma...@we...>.
+
+=head1 SEE ALSO
+
+L<WebFetch>, L<WebFetch::Data::Record>
Modified: trunk/lib/WebFetch/Input/Atom.pm
===================================================================
--- trunk/lib/WebFetch/Input/Atom.pm 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/lib/WebFetch/Input/Atom.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -19,12 +19,56 @@
use Exception::Class (
);
+=head1 NAME
+
+WebFetch::Input::Atom - WebFetch input from Atom feeds
+
+=head1 SYNOPSIS
+
+This is an input module for WebFetch which accesses an Atom feed.
+The --source parameter contains the URL of the feed.
+
+From the command line:
+
+C<perl -w -MWebFetch::Input::Atom -e "&fetch_main" -- --dir directory
+ --source atom-feed-url [...WebFetch output options...]>
+
+In perl scripts:
+
+ use WebFetch::Input::Atom;
+
+ my $obj = WebFetch->new(
+ "dir" => "/path/to/fetch/workspace",
+ "source" => "http://search.twitter.com/search.atom?q=%23twiki",
+ "source_format" => "atom",
+ "dest" => "dump",
+ "dest_format" = "/path/to/dump/file",
+ );
+ $obj->do_actions; # process output
+ $obj->save; # save results
+
+
+=head1 DESCRIPTION
+
+This module gets the current headlines from a site-local file.
+
+The I<--input> parameter specifies a file name which contains news to be
+posted. See L<"FILE FORMAT"> below for details on contents to put in the
+file. I<--input> may be specified more than once, allowing a single news
+output to come from more than one input. For example, one file could be
+manually maintained in CVS or RCS and another could be entered from a
+web form.
+
+After this runs, the file C<site_news.html> will be created or replaced.
+If there already was a C<site_news.html> file, it will be moved to
+C<Osite_news.html>.
+
+=cut
+
+
our @Options = ();
our $Usage = "";
-# configuration parameters
-our $num_links = 5;
-
# no user-servicable parts beyond this point
# register capabilities with WebFetch
@@ -35,30 +79,18 @@
{
my ( $self ) = @_;
- # set parameters for WebFetch routines
- if ( !defined $self->{num_links}) {
- $self->{num_links} = $WebFetch::Input::Atom::num_links;
- }
- if ( !defined $self->{style}) {
- $self->{style} = {};
- $self->{style}{para} = 1;
- }
-
# set up Webfetch Embedding API data
- $self->{data} = {};
- $self->{data}{fields} = [ "id", "updated", "title", "author", "link",
- "summary", "content", "xml" ];
+ $self->data->add_fields( "id", "updated", "title", "author", "link",
+ "summary", "content", "xml" );
# defined which fields match to which "well-known field names"
- $self->{data}{wk_names} = {
+ $self->data->add_wk_names(
+ "id" => "id",
"title" => "title",
"url" => "link",
"date" => "updated",
"summary" => "summary",
- };
- $self->{data}{records} = [];
+ );
- # process the links
-
# parse data file
$self->parse_input();
@@ -101,15 +133,15 @@
# save the data record
my $id = extract_value( $entry->id() );
my $title = extract_value( $entry->title() );
- my $author = extract_value( $entry->author->name );
+ my $author = ( defined $entry->author )
+ ? extract_value( $entry->author->name ) : "";
my $link = extract_value( $entry->link->href );
my $updated = extract_value( $entry->updated() );
my $summary = extract_value( $entry->summary() );
my $content = extract_value( $entry->content() );
my $xml = $entry->as_xml();
- push @{$self->{data}{records}},
- [ $id, $updated, $title, $author, $link, $summary,
- $content, $xml ];
+ $self->data->add_record( $id, $updated, $title,
+ $author, $link, $summary, $content, $xml );
}
}
@@ -117,36 +149,6 @@
__END__
# POD docs follow
-=head1 NAME
-
-WebFetch::Input::Atom - download and save an Atom feed
-
-=head1 SYNOPSIS
-
-In perl scripts:
-
-C<use WebFetch::Input::Atom;>
-
-From the command line:
-
-C<perl -w -MWebFetch::Input::Atom -e "&fetch_main" -- --dir directory
- --source atom-feed-url [...WebFetch output options...]>
-
-=head1 DESCRIPTION
-
-This module gets the current headlines from a site-local file.
-
-The I<--input> parameter specifies a file name which contains news to be
-posted. See L<"FILE FORMAT"> below for details on contents to put in the
-file. I<--input> may be specified more than once, allowing a single news
-output to come from more than one input. For example, one file could be
-manually maintained in CVS or RCS and another could be entered from a
-web form.
-
-After this runs, the file C<site_news.html> will be created or replaced.
-If there already was a C<site_news.html> file, it will be moved to
-C<Osite_news.html>.
-
=head1 Atom FORMAT
Atom is an XML format defined at http://atompub.org/rfc4287.html
Modified: trunk/lib/WebFetch/Input/PerlStruct.pm
===================================================================
--- trunk/lib/WebFetch/Input/PerlStruct.pm 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/lib/WebFetch/Input/PerlStruct.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -1,4 +1,3 @@
-#
# WebFetch::Input::PerlStruct.pm
# push a Perl structure with pre-parsed news into WebFetch
#
@@ -11,15 +10,26 @@
use strict;
use base "WebFetch";
-use Carp;
+# define exceptions/errors
+use Exception::Class (
+ "WebFetch::Input::PerlStruct::Exception::NoStruct" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_nostruct",
+ description => "no 'content' structure was provided",
+ },
-our $format;
-our @Options = ( "format:s" );
+ "WebFetch::Input::PerlStruct::Exception::BadStruct" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_badstruct",
+ description => "content of 'content' was not recognizable",
+ },
+
+);
+
+our @Options = ( );
our $Usage = "";
# configuration parameters
-our $num_links = 5;
-our $default_format = "<a href=\"%url%\">%title%</a>";
# no user-servicable parts beyond this point
@@ -30,40 +40,27 @@
{
my ( $self ) = @_;
- # set parameters for WebFetch routines
- $self->{num_links} = $WebFetch::Input::PerlStruct::num_links;
- if ( defined $format ) {
- $self->{"format"} = $format;
- } else {
- $self->{"format"} = $WebFetch::Input::PerlStruct::default_format;
- }
-
# get the content from the provided perl structure
if ( !defined $self->{content}) {
- croak "WebFetch::Input::PerlStruct: content struct does not exist\n";
+ throw_nostruct "content struct does not exist";
}
- if ( ref($self->{content}) != "ARRAY" ) {
- croak "WebFetch::Input::PerlStruct: content is not an ARRAY ref\n";
- }
-
- # collate $self->{content} into @content_links by fields from format
- my ( @content_links, $part );
- my @fields = ( $self->{"format"} =~ /%([^%]*)%/go );
- foreach $part ( @{$self->{content}} ) {
- my ( $fname, $subparts );
- $subparts= [];
- foreach $fname ( @fields ) {
- push @$subparts, "".((defined $part->{$fname})
- ? $part->{$fname} : "" );
+ if ( ref($self->{content})->isa( "WebFetch::Data::Store" )) {
+ $self->{data} = $self->{content};
+ return;
+ } elsif ( ref($self->{content}) eq "HASH" ) {
+ if (( exists $self->{content}{fields})
+ and ( exists $self->{content}{records})
+ and ( exists $self->{content}{wk_names}))
+ {
+ $self->data->{fields} = $self->{content}{fields};
+ $self->data->{wk_names} = $self->{content}{wk_names};
+ $self->data->{records} = $self->{content}{records};
+ return;
}
- push ( @content_links, $subparts );
}
-
- # build data structure
- $self->{data} = {};
+ throw_badstruct "content should be a WebFetch::Data::Store";
}
-
1;
__END__
# POD docs follow
@@ -81,11 +78,8 @@
C<$obj = new WebFetch::Input::PerlStruct (
"content" => content_struct,
"dir" => output_dir,
- "file" => output_file,
- [ "format" => format_string, ]
- [ "export" => wf_export_filename, ]
- [ "font_size" => font_size, ]
- [ "font_face" => font_face, ]
+ "dest" => output_file,
+ "dest_format" => output_format, # used to select WebFetch output module
[ "group" => file_group_id, ]
[ "mode" => file_mode_perms, ]
[ "quiet" => 1 ]);>
@@ -116,55 +110,26 @@
=head1 THE CONTENT STRUCTURE
-The $content_struct parameter must be a reference to an array of hashes.
+The $content_struct parameter may be in either of two formats.
+
+If $content_struct is a hash reference containing entries called
+"fields", "wk_names" and "records", then it is assumed to be already
+in the format of the "data" element of the WebFetch Embedding API.
+
+Otherwise, it must be a reference to an array of hashes.
Each of the hashes represents a separate news item,
in the order they should be displayed.
-The fields of each has entry must provide enough information to
-match field names in all the the output formats you're using.
-Output formats include the following:
-=over 4
+The field names should be consistent through all records.
+WebFetch uses the field names from the first record and assumes the
+remainder are identical.
-=item HTML output file
-
-All the fields used in the $format_string (see below) must be present
-for generation of the HTML output.
-
-=item WebFetch export
-
-The $format_string also determines the fields that will be used
-for WebFetch export.
-Note that the WebFetch::General module expects by default to find
-fields called "url" and "title".
-So if you use something different from the default,
-you must provide your format string in the instructions
-for sites that fetch news from you.
-(Otherwise their WebFetch::General won't be looking for the fields
-you're providing.)
-
-=item MyNetscape export
-
-The MyNetscape export function expects to find fields called
-"title" and "url", and will skip any hash entry which is
-missing either of them.
-
-=back
-
-=head1 FORMAT STRINGS
-
-WebFetch::Input::PerlStruct uses a format string identical to WebFetch::General.
-The default format for retrieved data is
-
-<a href="%url%">%title%</a>
-
-See the WebFetch::General documentation for more details.
-
The names of the fields are chosen by the calling function.
-Though for the convenience of the user,
-the author of an exporting module should keep in mind the
-default WebFetch::Input::PerlStruct format uses fields called "url" and "title".
-If you use fields by different names, make sure your code provides those
-fields in the $content_struct parameter.
+If an array called "wk_names" is provided then it used to map
+well-known field names of the WebFetch Embedding API to field names in
+this data.
+Otherwise, meaning can only be applied to field names if they already
+match WebFetch's well-known field names.
=head1 AUTHOR
Modified: trunk/lib/WebFetch/Input/RSS.pm
===================================================================
--- trunk/lib/WebFetch/Input/RSS.pm 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/lib/WebFetch/Input/RSS.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -19,47 +19,52 @@
use Exception::Class (
);
+=head1 NAME
+
+WebFetch::Input::RSS - download and save an RSS feed
+
+=cut
+
our @Options = ();
our $Usage = "";
# configuration parameters
-our $num_links = 5;
# no user-servicable parts beyond this point
# register capabilities with WebFetch
__PACKAGE__->module_register( "input:rss" );
+=head1 SYNOPSIS
+
+In perl scripts:
+
+C<use WebFetch::Input::RSS;>
+
+From the command line:
+
+C<perl -w -MWebFetch::Input::RSS -e "&fetch_main" -- --dir directory
+ --source rss-feed-url [...WebFetch output options...]>
+
+=cut
+
# called from WebFetch main routine
sub fetch
{
my ( $self ) = @_;
- # set parameters for WebFetch routines
- if ( !defined $self->{num_links}) {
- $self->{num_links} = $WebFetch::Input::RSS::num_links;
- }
- if ( !defined $self->{style}) {
- $self->{style} = {};
- $self->{style}{para} = 1;
- }
-
# set up Webfetch Embedding API data
- $self->{data} = {};
- $self->{data}{fields} = [ "pubDate", "title", "link", "category",
- "description" ];
+ $self->data->add_fields( "pubDate", "title", "link", "category",
+ "description" );
# defined which fields match to which "well-known field names"
- $self->{data}{wk_names} = {
+ $self->data->add_wk_names(
"title" => "title",
"url" => "link",
"date" => "pubDate",
"summary" => "description",
"category" => "category",
- };
- $self->{data}{records} = [];
+ );
- # process the links
-
# parse data file
$self->parse_input();
@@ -156,48 +161,16 @@
? $item->{category} : "";
my $description = ( defined $item->{description})
? $item->{description} : "";
- push @{$self->{data}{records}},
- [ $pub_date, $title, $link, $category, $description ];
+ $self->data->add_record( $pub_date, $title, $link,
+ $category, $description );
$pos++;
}
}
-#---------------------------------------------------------------------------
-
-#
-# utility functions
-#
-
-# generate a printable version of the datestamp
-sub printstamp
-{
- my ( $stamp ) = @_;
- my ( $year, $mon, $day ) = ( $stamp =~ /^(....)(..)(..)/ );
-
- return Month_to_Text(int($mon))." ".int($day).", $year";
-}
-
-#---------------------------------------------------------------------------
-
1;
__END__
# POD docs follow
-=head1 NAME
-
-WebFetch::Input::RSS - download and save an RSS feed
-
-=head1 SYNOPSIS
-
-In perl scripts:
-
-C<use WebFetch::Input::RSS;>
-
-From the command line:
-
-C<perl -w -MWebFetch::Input::RSS -e "&fetch_main" -- --dir directory
- --source rss-feed-url [...WebFetch output options...]>
-
=head1 DESCRIPTION
This module gets the current headlines from a site-local file.
Modified: trunk/lib/WebFetch/Input/SiteNews.pm
===================================================================
--- trunk/lib/WebFetch/Input/SiteNews.pm 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/lib/WebFetch/Input/SiteNews.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -13,6 +13,12 @@
use Carp;
use Date::Calc qw(Today Delta_Days Month_to_Text);
+=head1 NAME
+
+WebFetch::Input::SiteNews - download and save SiteNews headlines
+
+=cut
+
# set defaults
our ( $cat_priorities, $now, $nowstamp );
@@ -30,6 +36,35 @@
# register capabilities with WebFetch
__PACKAGE__->module_register( "cmdline", "input:sitenews" );
+=head1 SYNOPSIS
+
+In perl scripts:
+
+C<use WebFetch::Input::SiteNews;>
+
+From the command line:
+
+C<perl -w -MWebFetch::Input::SiteNews -e "&fetch_main" -- --dir directory
+ --source news-file --short short-form-output-file
+ --long long-form-output-file>
+
+=head1 DESCRIPTION
+
+This module gets the current headlines from a site-local file.
+
+The I<--source> parameter specifies a file name which contains news to be
+posted. See L<"FILE FORMAT"> below for details on contents to put in the
+file. I<--source> may be specified more than once, allowing a single news
+output to come from more than one input. For example, one file could be
+manually maintained in CVS or RCS and another could be entered from a
+web form.
+
+After this runs, the file C<site_news.html> will be created or replaced.
+If there already was a C<site_news.html> file, it will be moved to
+C<Osite_news.html>.
+
+=cut
+
# constants for state names
sub initial_state { 0; }
sub attr_state { 1; }
@@ -49,19 +84,17 @@
}
# set up Webfetch Embedding API data
- $self->{data} = {};
$self->{actions} = {};
- $self->{data}{fields} = [ "date", "title", "priority", "expired",
- "position", "label", "url", "category", "text" ];
+ $self->data->add_fields( "date", "title", "priority", "expired",
+ "position", "label", "url", "category", "text" );
# defined which fields match to which "well-known field names"
- $self->{data}{wk_names} = {
+ $self->data->add_wk_names(
"title" => "title",
"url" => "url",
"date" => "date",
"summary" => "text",
"category" => "category"
- };
- $self->{data}{records} = [];
+ );
# process the links
@@ -228,83 +261,14 @@
my $text = ( defined $item->{text}) ? $item->{text} : "";
my $url_prefix = ( defined $self->{url_prefix})
? $self->{url_prefix} : "";
- push @{$self->{data}{records}},
- [ printstamp($posted), $title, priority( $item ),
+ $self->data->add_record(
+ printstamp($posted), $title, priority( $item ),
expired( $item ), $pos, $label,
- $url_prefix."#".$label, $category, $text ];
+ $url_prefix."#".$label, $category, $text );
$pos++;
}
}
-# format handler function specific to this module's long-news output format
-sub fmt_handler_sitenews_long
-{
- my ( $self, $filename ) = @_;
-
- # sort events for long display
- my @long_news = sort {
- # sort news entries for long display
- # sorting priority:
- # date first
- # category/priority second
- # reverse file order last
-
- # sort by date
- my $lbl_fnum = $self->fname2fnum("label");
- my ( $a_date, $b_date) = ( $a->[$lbl_fnum], $b->[$lbl_fnum]);
- $a_date =~ s/-.*//;
- $b_date =~ s/-.*//;
- if ( $a_date ne $b_date ) {
- return $b_date cmp $a_date;
- }
-
- # sort by priority (within same date)
- my $pri_fnum = $self->fname2fnum("priority");
- if ( $a->[$pri_fnum] != $b->[$pri_fnum] ) {
- return $a->[$pri_fnum] <=> $b->[$pri_fnum];
- }
-
- # sort by chronological order (within same date and priority)
- return $a->[$lbl_fnum] cmp $b->[$lbl_fnum];
- } @{$self->{data}{records}};
-
- # process the links for the long list
- my ( @long_text, $prev, $url_prefix, $i );
- $url_prefix = ( defined $self->{url_prefix})
- ? $self->{url_prefix}
- : "";
- $prev=undef;
- push @long_text, "<dl>";
- my $lbl_fnum = $self->fname2fnum("label");
- my $date_fnum = $self->fname2fnum("date");
- my $title_fnum = $self->fname2fnum("title");
- my $txt_fnum = $self->fname2fnum("text");
- my $exp_fnum = $self->fname2fnum("expired");
- my $pri_fnum = $self->fname2fnum("priority");
- for ( $i = 0; $i <= $#long_news; $i++ ) {
- my $news = $long_news[$i];
- if (( ! defined $prev->[$date_fnum]) or
- $prev->[$date_fnum] ne $news->[$date_fnum])
- {
- push @long_text, "<dt>".$news->[$date_fnum];
- push @long_text, "<dd>";
- }
- push @long_text, "<a name=\"".$news->[$lbl_fnum]."\">"
- .$news->[$txt_fnum]."</a>\n"
- ."<!--- priority: ".$news->[$pri_fnum]
- .($news->[$exp_fnum] ? " expired" : "")
- ." --->";
- push @long_text, "<p>";
- $prev = $news;
- }
- push @long_text, "</dl>";
-
- # store it for later save to disk
- $self->html_savable( $self->{long_path}, join("\n",@long_text)."\n" );
-}
-
-#---------------------------------------------------------------------------
-
#
# utility functions
#
@@ -351,43 +315,10 @@
}
}
-#---------------------------------------------------------------------------
-
1;
__END__
# POD docs follow
-=head1 NAME
-
-WebFetch::Input::SiteNews - download and save SiteNews headlines
-
-=head1 SYNOPSIS
-
-In perl scripts:
-
-C<use WebFetch::Input::SiteNews;>
-
-From the command line:
-
-C<perl -w -MWebFetch::Input::SiteNews -e "&fetch_main" -- --dir directory
- --source news-file --short short-form-output-file
- --long long-form-output-file>
-
-=head1 DESCRIPTION
-
-This module gets the current headlines from a site-local file.
-
-The I<--source> parameter specifies a file name which contains news to be
-posted. See L<"FILE FORMAT"> below for details on contents to put in the
-file. I<--source> may be specified more than once, allowing a single news
-output to come from more than one input. For example, one file could be
-manually maintained in CVS or RCS and another could be entered from a
-web form.
-
-After this runs, the file C<site_news.html> will be created or replaced.
-If there already was a C<site_news.html> file, it will be moved to
-C<Osite_news.html>.
-
=head1 FILE FORMAT
The WebFetch::Input::SiteNews data format is used to set up news for the
Modified: trunk/lib/WebFetch/Output/Dump.pm
===================================================================
--- trunk/lib/WebFetch/Output/Dump.pm 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/lib/WebFetch/Output/Dump.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -20,7 +20,12 @@
use Exception::Class (
);
+=head1 NAME
+WebFetch::Output::Dump - save data in a Perl structure dump
+
+=cut
+
# set defaults
our ( @url, $cat_priorities, $now, $nowstamp );
@@ -35,23 +40,6 @@
# register capabilities with WebFetch
__PACKAGE__->module_register( "output:dump" );
-# Perl structure dump format handler
-sub fmt_handler_dump
-{
- my ( $self, $filename ) = @_;
-
- $self->raw_savable( $filename, Dumper( $self->{data}));
- 1;
-}
-
-1;
-__END__
-# POD docs follow
-
-=head1 NAME
-
-WebFetch::Output::Dump - save data in a Perl structure dump
-
=head1 SYNOPSIS
In perl scripts:
@@ -65,10 +53,30 @@
=head1 DESCRIPTION
-This module gets the current news headlines from a site-local file.
+This is an output module for WebFetch which simply outputs a Perl
+structure dump from C<Data::Dumper>. It can be read again by a Perl
+script using C<eval>.
-TODO: add description
+=item $obj->fmt_handler_dump( $filename )
+This function dumps the data into a string for saving by the WebFetch::save()
+function.
+
+=cut
+
+# Perl structure dump format handler
+sub fmt_handler_dump
+{
+ my ( $self, $filename ) = @_;
+
+ $self->raw_savable( $filename, Dumper( $self->{data}));
+ 1;
+}
+
+1;
+__END__
+# POD docs follow
+
=head1 AUTHOR
WebFetch was written by Ian Kluft
Modified: trunk/lib/WebFetch/Output/TT.pm
===================================================================
--- trunk/lib/WebFetch/Output/TT.pm 2009-09-21 04:37:45 UTC (rev 67)
+++ trunk/lib/WebFetch/Output/TT.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -23,7 +23,12 @@
);
+=head1 NAME
+WebFetch::Output::TT - save data via the Perl Template Toolkit
+
+=cut
+
# set defaults
our @Options = ( "template=s", "tt_include:s" );
@@ -34,6 +39,29 @@
# register capabilities with WebFetch
__PACKAGE__->module_register( "cmdline", "output:tt" );
+=head1 SYNOPSIS
+
+In perl scripts:
+
+C<use WebFetch::Output::TT;>
+
+From the command line:
+
+C<perl -w -MWebFetch::Output::TT -e "&fetch_main" --
+ [...WebFetch input options...] --dir directory
+ --dest_format tt --dest dest-path --template tt-file >
+
+=head1 DESCRIPTION
+
+This module saves output via the Perl Template Toolkit.
+
+=item $obj->fmt_handler_tt( $filename )
+
+This function formats the data according to the Perl Template Toolkit
+template provided in the --template parameter.
+
+=cut
+
# Perl Template Toolkit format handler
sub fmt_handler_tt
{
@@ -52,11 +80,10 @@
my $template = Template->new( \%tt_config );
# process template
- my $result = $template->process( $self->{template}, $self->{data},
- \$output );
+ $template->process( $self->{template}, { data => $self->{data}},
+ \$output, { binmode => ':utf8'} )
+ or throw_template $template->error();
- $result or throw_template ( $template->error());
-
$self->raw_savable( $filename, $output );
1;
}
@@ -65,27 +92,6 @@
__END__
# POD docs follow
-=head1 NAME
-
-WebFetch::Output::TT - save data via the Perl Template Toolkit
-
-=head1 SYNOPSIS
-
-In perl scripts:
-
-C<use WebFetch::Output::TT;>
-
-From the command line:
-
-C<perl -w -MWebFetch::Output::TT -e "&fetch_main" -- --dir directory
- --dest_format tt --dest dest-path [...WebFetch output options...]>
-
-=head1 DESCRIPTION
-
-This module saves output via the Perl Template Toolkit.
-
-TODO: add description
-
=head1 AUTHOR
WebFetch was written by Ian Kluft
@@ -95,12 +101,13 @@
=head1 SEE ALSO
=for html
-<a href="WebFetch.html">WebFetch</a>
+<a href="WebFetch.html">WebFetch</a>,
+<a href="http://www.template-toolkit.org/>Perl Template Toolkit</a>
=for text
-WebFetch
+WebFetch, Perl Template Toolkit
=for man
-WebFetch
+WebFetch, Perl Template Toolkit
=cut
Copied: trunk/lib/WebFetch/Output/TWiki.pm (from rev 67, branches/v0.13/lib/WebFetch/Output/TWiki.pm)
===================================================================
--- trunk/lib/WebFetch/Output/TWiki.pm (rev 0)
+++ trunk/lib/WebFetch/Output/TWiki.pm 2009-09-21 04:59:20 UTC (rev 68)
@@ -0,0 +1,548 @@
+#
+# 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",
+ },
+ "WebFetch::Output::TWiki::Exception::FieldNotSpecified" => {
+ isa => "WebFetch::Exception",
+ alias => "throw_field_not_specified",
+ description => "a required field was not defined or found",
+ },
+);
+
+=head1 NAME
+
+WebFetch::Output::TWiki - WebFetch output to TWiki web site
+
+=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
+
+# register capabilities with WebFetch
+__PACKAGE__->module_register( "cmdline", "output:twiki" );
+
+=head1 SYNOPSIS
+
+This is an output module for WebFetch which places the data in pages
+on a TWiki web site. Some of its configuration information is read from
+a TWiki page. Calling or command-line parameters point to the TWiki page
+which has the configuration and a search key to locate the correct line
+in a table.
+
+From the command line...
+
+ perl -w -I$libdir -MWebFetch::Input::Atom -MWebFetch::Output::TWiki -e "&fetch_main" -- --dir "/path/to/fetch/worskspace" --source "http://search.twitter.com/search.atom?q=%23twiki" --dest=twiki --twiki_root=/var/www/twiki --config_topic=Feeds.WebFetchConfig --config_key=twiki
+
+From Perl code...
+
+ use WebFetch;
+
+ my $obj = WebFetch->new(
+ "dir" => "/path/to/fetch/workspace",
+ "source" => "http://search.twitter.com/search.atom?q=%23twiki",
+ "source_format" => "atom",
+ "dest" => "twiki",
+ "dest_format" = "twiki",
+ "twiki_root" => "/var/www/twiki",
+ "config_topic" => "Feeds.WebFetchConfig",
+ "config_key" => "twiki",
+ );
+ $obj->do_actions; # process output
+ $obj->save; # save results
+
+=head1 configuration from TWiki topic
+
+The configuration information on feeds is kept in a TWiki page. You can
+specify any page with a web and topic name, for example C<--config_topic=Feeds.WebFetchConfig> .
+
+The contents of that configuration page could look like this, though with
+any feeds you want to configure. The "Key" field matches the --config_key
+command-line parameter, and then brings in the rest of the configuration
+info from that line. An example is shown below.
+
+=over
+C<< ---+ !WebFetch Configuration >>
+
+C<< The following table is used by !WebFetch to configure news feeds >>
+
+C<< %STARTINCLUDE% >>
+C<< | *Key* | *Web* | *Parent* | *Prefix* | *Template* | *Form* | *Options* | *Modul >>
+e* | *Source* |
+C<< | ikluft-twitter | Feeds | TwitterIkluftFeed | TwitterIkluft | AtomFeedTemplate | AtomFeedForm | separate_topics | Atom | http://twitter.com/statuses/user_timeline/37786023.rss | >>
+C<< | twiki-twitter | Feeds | TwitterTwikiFeed | TwitterTwiki | AtomFeedTemplate | AtomFeedForm | separate_topics | Atom | http://search.twitter.com/search.atom?q=%23twiki | >>
+C<< | cnn | Feeds | RssCnn | RssCnn | RssFeedTemplate | RssFeedForm | separate_topics | RSS | http://rss.cnn.com/rss/cnn_topstories.rss | >>
+C<< %STOPINCLUDE% >>
+=back
+
+The C<%STARTINCLUDE%> and C<%STOPINCLUDE%> are not required. However, if
+present, they are used as boundaries for the inclusion like in a normal
+INCLUDE operation on TWiki.
+
+=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;
+ WebFetch::debug "read entries: ".join( ', ', @entries );
+
+ # first line contains field headings
+ if ( ! @fnames) {
+ # save table headings as field names
+ my $field;
+ foreach $field ( @entries ) {
+ my $tmp = lc($field);
+ $tmp =~ s/\W//g;
+ push @fnames, $tmp;
+ }
+ next;
+ }
+ 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++ ) ...
[truncated message content] |
