"Fossies" - the Fresh Open Source Software Archive

Member "sendpage-1.001001/lib/Sendpage/PageQueue.pm" (3 Jan 2008, 4932 Bytes) of package /linux/privat/old/sendpage-1.001001.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "PageQueue.pm" see the Fossies "Dox" file reference documentation.

    1 package Sendpage::PageQueue;
    2 
    3 # this module uses the Queue module, but plays with Pages on top of it
    4 #
    5 # $Id: PageQueue.pm 214 2006-07-05 16:24:26Z keescook $
    6 #
    7 # Copyright (C) 2000-2004 Kees Cook
    8 # kees@outflux.net, http://outflux.net/
    9 #
   10 # This program is free software; you can redistribute it and/or
   11 # modify it under the terms of the GNU General Public License
   12 # as published by the Free Software Foundation; either version 2
   13 # of the License, or (at your option) any later version.
   14 #
   15 # This program is distributed in the hope that it will be useful,
   16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18 # GNU General Public License for more details.
   19 #
   20 # You should have received a copy of the GNU General Public License
   21 # along with this program; if not, write to the Free Software
   22 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
   23 # <URL:http://www.gnu.org/copyleft/gpl.html>
   24 
   25 use strict;
   26 use warnings;
   27 
   28 our @ISA = ("Sendpage::Queue");
   29 
   30 # we're extending the Queue module, which is only file based, and in
   31 # the hopes that we can attach this to a better Queue module if one
   32 # ever surfaces on CPAN
   33 use Sendpage::Queue;
   34 
   35 # other stuff
   36 use Sendpage::Page;
   37 use Sendpage::Recipient;
   38 
   39 =head1 NAME
   40 
   41 Sendpage::PageQueue - extends the Queue module, adding the Page module smarts
   42 
   43 =head1 SYNOPSIS
   44 
   45  $pqueue = Sendpage::PageQueue($config);
   46 
   47  # read waiting pages
   48  while ($fh = $pqueue->getPage($db)) {
   49      # build up $page
   50      @stuff = $pqueue->pullPageFromFile($db, $fh);
   51      $page = Sendpage::Page->new(@stuff);
   52 
   53      # do something to change $page
   54 
   55      # write changes back to queue
   56      $pqueue->writePage($page);
   57 
   58      $pqueue->fileDone();
   59  }
   60 
   61  # add a new page
   62  $fh = $pqueue->addPage($page);
   63 
   64 =head1 DESCRIPTION
   65 
   66 This module is used internally by L<sendpage> for is page processing.
   67 
   68 =cut
   69 
   70 sub new
   71 {
   72     # get our args
   73     my $proto  = shift;
   74     my $config = shift;     # we'll need the config info
   75     my $class  = ref($proto) || $proto;
   76     my $self   = $class->SUPER::new(@_);
   77 
   78     $self->{CONFIG} = $config;
   79 
   80     return bless $self => $class;
   81 }
   82 
   83 sub getPage
   84 {
   85     my $self = shift;
   86     my $db   = shift;
   87 
   88     my $handle = $self->getReadyFile();
   89 
   90     if (defined $handle) {
   91     # read the data
   92     my $page = new Sendpage::Page
   93         $self->pullPageFromFile($db, $handle);
   94 
   95     $page->option('FILE', $self->file()) if $page;
   96     return $page;
   97     } else {
   98     return undef;
   99     }
  100 }
  101 
  102 sub pullPageFromFile
  103 {
  104     my $self = shift;
  105     my $db   = shift;
  106     my $fh   = shift;
  107 
  108     my($line, $body, @lines, @recips, $text, %options, $recip);
  109 
  110     # rewind our file
  111     seek $fh, 0, 0;
  112 
  113     # load everything
  114     @lines = <$fh>;
  115 
  116     # clear everything!
  117     $body = 0;
  118     undef @recips;
  119     undef %options;
  120     undef $text;
  121 
  122     foreach $line (@lines) {
  123     chomp $line;
  124 
  125     #print STDERR "read line '$line' ";
  126     if ($body == 1) {
  127         #warn "(body)\n";
  128         $text .= $line . "\n";
  129     } else {
  130         if ($line =~ /^\s*$/) {
  131         # header/body break
  132         $body=1;
  133         #warn "\n";
  134         } else {
  135         my ($key, $value) = split(/:\s*/, $line, 2);
  136 
  137         #warn "(header: '$key' -> '$value')\n";
  138 
  139         if ($key eq "to") {
  140             my(@parts, %data, $key, $line, $datum);
  141             undef %data;
  142             @parts = split /,/ => $value;
  143             $value = shift @parts;
  144             foreach $line (@parts) {
  145             ($key, $datum) = split(/=/, $line, 2);
  146             $data{$key} = $datum;
  147             }
  148 
  149             $recip = new Sendpage::Recipient
  150             $self->{CONFIG}, $db, $value, \%data;
  151             if (defined $recip) {
  152             push @recips, $recip;
  153             } else {
  154             $main::log->do('warning',
  155                        "bad recip: '%s'",$value);
  156             }
  157         } else {
  158             $options{$key} = $value;
  159         }
  160         }
  161     }
  162     }
  163 
  164     # rewind our file
  165     seek $fh, 0, 0;
  166 
  167     # drop last CR .... FIXME: is this right?  Hm.
  168     chomp $text;
  169 
  170     return (\@recips, \$text, \%options);
  171 }
  172 
  173 sub addPage
  174 {
  175     my ($self, $page) = @_;
  176 
  177     my($rc, $filename);
  178     my $handle = $self->getNewFile();
  179 
  180     return undef unless defined $handle;
  181 
  182     $page->option("queued", time);
  183     $rc = $self->writePage($page);
  184     $filename = $self->doneNewFile();
  185     return $filename if $rc;
  186     return $rc;
  187 }
  188 
  189 sub writePage
  190 {
  191     my ($self, $page) = @_;
  192 
  193     my $handle = $self->{OPEN};
  194 
  195     return undef unless defined $handle;
  196 
  197     # clear this file, just in case
  198     seek $handle, 0, 0;
  199     truncate $handle, 0;
  200 
  201     print $handle $page->dump();
  202 
  203     return 1;
  204 }
  205 
  206 1;              # This is a module
  207 
  208 __END__
  209 
  210 =head1 AUTHOR
  211 
  212 Kees Cook <kees@outflux.net>
  213 
  214 =head1 BUGS
  215 
  216 Obviously, needs more docs.
  217 
  218 =head1 SEE ALSO
  219 
  220 Man pages: L<perl>, L<sendpage>.
  221 
  222 Module documentation: L<Sendpage::KeesConf>, L<Sendpage::KeesLog>,
  223 L<Sendpage::Modem>, L<Sendpage::PagingCentral>, L<Sendpage::Page>,
  224 L<Sendpage::Recipient>, L<Sendpage::Queue>.
  225 
  226 =head1 COPYRIGHT
  227 
  228 Copyright 2000 Kees Cook.
  229 
  230 This library is free software; you can redistribute it and/or
  231 modify it under the same terms as Perl itself.
  232 
  233 =cut