/[webpac2]/trunk/lib/WebPAC/Output/SWISH.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Output/SWISH.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1149 by dpavlin, Fri Apr 24 16:58:09 2009 UTC revision 1161 by dpavlin, Sat Apr 25 14:18:06 2009 UTC
# Line 8  use lib 'lib'; Line 8  use lib 'lib';
8  use base qw/WebPAC::Common Class::Accessor/;  use base qw/WebPAC::Common Class::Accessor/;
9  __PACKAGE__->mk_accessors(qw(  __PACKAGE__->mk_accessors(qw(
10          database          database
11            input
12          type          type
13    
14          index_path          index_path
15  ));  ));
16    
17  use File::Path qw/make_path/;  use File::Path qw/mkpath/;
18  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
19  use YAML;  use YAML;
20  use JSON;  use JSON;
# Line 63  sub init { Line 64  sub init {
64    
65          my $database = $self->database || $log->logdie("need database");          my $database = $self->database || $log->logdie("need database");
66    
67          make_path $dir if ! -e $dir;          mkpath $dir if ! -e $dir;
68    
69          my $path = "$dir/$database.conf";          my $path = "$dir/$database.conf";
70    
# Line 134  sub add { Line 135  sub add {
135    
136          my $database = $self->database || $log->logconfess('no database in $self');          my $database = $self->database || $log->logconfess('no database in $self');
137    
138          my $uri = $self->database . "/$id";          my $uri = $self->database . '/' . $self->input . "/$id";
139          $log->debug("creating $uri");          $log->debug("creating $uri");
140    
141          # filter all tags which have type defined          # filter all tags which have type defined
# Line 147  sub add { Line 148  sub add {
148    
149          return unless (@tags);          return unless (@tags);
150    
151          my $xml = qq{<xml>};          my $xml = qq{<all>};
152    
153            $xml .= "<$_>" . $self->$_ . "</$_>" foreach ( 'database', 'input' );
154    
155          my $data;          my $data;
156    
# Line 161  sub add { Line 164  sub add {
164                  next if ! $vals;                  next if ! $vals;
165    
166                  $vals =~ s/($escape_re)/$escape{$1}/gs;                  $vals =~ s/($escape_re)/$escape{$1}/gs;
167                  $xml .= qq{<$tag><![CDATA[$vals]]></$tag>};                  # BW & EW are our markers for tag boundry
168                    $xml .= qq{<$tag><![CDATA[BW $vals EW]]></$tag>};
169    
170                  $self->{stats}->{attr}->{$tag}++;                  $self->{stats}->{attr}->{$tag}++;
171    
# Line 172  sub add { Line 176  sub add {
176          $data = to_json($data);          $data = to_json($data);
177          $xml .= qq{<data><![CDATA[$data]]></data>};          $xml .= qq{<data><![CDATA[$data]]></data>};
178    
179          $xml .= qq{</xml>\n};          $xml .= qq{</all>\n};
180    
181          my $len = length($xml);          my $len = length($xml);
182    
# Line 181  sub add { Line 185  sub add {
185          print $fh "Path-Name: $uri\nContent-Length: $len\nDocument-Type: XML\n\n$xml" or          print $fh "Path-Name: $uri\nContent-Length: $len\nDocument-Type: XML\n\n$xml" or
186                  die "can't add $uri: $@\n$xml";                  die "can't add $uri: $@\n$xml";
187    
188          warn "$xml\n";          $log->debug( $xml );
189    
190          return 1;          return 1;
191  }  }
Legend:
Removed from v.1149  
changed lines
  Added in v.1161
  ViewVC Help
Powered by ViewVC 1.1.26